I use the following function to export the output data from Access to Excel. It had been running fine, until recently it suddenly popped up an error (-2147319779 Automation error Library not registered.) in all applications that's been using this code.
I stepped through the code, it stopped right at the line "Set xl = New Excel.Application". What has been going on? Causes by Excel? I have been using Excel 2010.
Function SendRecordset()
On Error GoTo ErrorHandler
'Declare objects and variables
Dim f As Form
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim xl As Excel.Application
Dim xlwkbk As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim c As Integer
Dim i As Integer
Dim strFilePath As String
strFilePath = Forms!frmQuery!txtLocationSave.Value
'create a new instance of Excel, start a work book,
Set xl = New Excel.Application
Set xlwkbk = xl.Workbooks.Add
'make the instance of Excel visible
xl.Visible = True
'add a new worksheet and name it.
Set xlsheet = xlwkbk.Worksheets.Add
xlsheet.Name = "TEST ONLY"
'start a new recordset, assign dataset to recordset object
Set f = Forms!frmQuery
Set db = CurrentDb()
Set rs = db.OpenRecordset(f.RecordSource, dbOpenDynaset)
'check recordcount property
If rs.RecordCount < 1 Then
MsgBox ("There are no records to output")
GoTo ExitFunction
End If
'copy records to the active Excel sheet starting with cell A2 in order to leave room for column headings
With xlsheet
xl.Range("A2").CopyFromRecordset rs
End With
'Enumerate through the fields in the recordset and add column heading names to the spreadsheet
c = 1 'assign 1 to variable c
For i = 0 To rs.Fields.Count - 1
xl.Cells(1, c).Value = rs.Fields(i).Name
c = c + 1
Next i
'**************************Start Excel Formatting*******************************************************************************************************
xl.Application.ScreenUpdating = False
xl.Cells.Select 'select cells, set font size and color
With xl.Selection.Font
.Name = "Arial"
.Size = 8
End With
xl.Columns.AutoFit
xl.Range("A1:A3").EntireRow.Insert
xl.Columns("I:I").Insert
xl.Range("A1").FormulaR1C1 = "Structure Data as of: " & " " & Format(f.txtDate, "yyyymmdd")
xl.Rows("4:4").Font.ColorIndex = 5
xl.Range("A1").Select 'the wksheet was selected, moving the focus to cell A1 will deselect the selected cells.
xl.Application.DisplayAlerts = False 'suppress Excel "overwrite previously saved files" message. By doing this Excel won't ask if you like to replace the old file.
xl.ActiveWorkbook.SaveAs Filename:= _
strFilePath, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
xl.Application.DisplayAlerts = True 'turn the warning back on
xl.Application.ScreenUpdating = True
'**************************Formatting done**************************************************************************************************************
ExitFunction:
'clean up
Set rs = Nothing
Set xl = Nothing
Set xlwkbk = Nothing
Set xlsheet = Nothing
Exit Function
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
End Function
Posted by: saigonf7q5@yahoo.com
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (1) |
Tidak ada komentar:
Posting Komentar