Public Function ChangetoExcel() Dim excel_app As Object Dim excel_sheet As Object Dim FileName As String FileName = "C:\" & ExcelName & ".xlsx" 'Dim rst As ADODB.Recordset 'Dim new_value As String Dim rerows As Integer Dim recols As Integer MyRecordset.MoveFirst Screen.MousePointer = vbHourglass DoEvents Set excel_app = CreateObject("Excel.Application") excel_app.Visible = False If Dir(FileName, vbDirectory) <> "" Then Else CreateExcel (FileName) End If excel_app.Workbooks.Open FileName:=FileName 'excel_app.Workbooks.Open FileName:="E:\" & ExcelName & ".xlsx" If Val(excel_app.Application.Version) >= 8 Then Set excel_sheet = excel_app.ActiveSheet Else Set excel_sheet = excel_app End If 

rerows = MyRecordset.RecordCount recols = MyRecordset.Fields.Count For i = 0 To rerows - 1 For j = 0 To recols - 1 excel_sheet.Cells(i + 1, j + 1) = MyRecordset.Fields(j) Next MyRecordset.MoveNext Next excel_app.Save excel_app.Quit Set excel_sheet = Nothing Set excel_app = Nothing Set MyRecordset = Nothing Screen.MousePointer = vbDefault ExportBtn.Enabled = False End Function Public Function CreateExcel(ByVal FileName As String) Dim xlApp As Excel.Application 

Dim xlBook As Excel.Workbook Dim xlChar As New Excel.Chart Dim xlSheet As New Excel.Worksheet Set xlApp = New Excel.Application Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets.Add xlBook.SaveAs (FileName) xlBook.Close xlApp.Quit Set xlApp = Nothing End Function