My form has an "Export to Excel" button. It runs a function which I found in a book. And it had been working perfectly. However, after my laptop was changed (from 32 bit to 64 bit machine), the "Export" function's stopped working. It produced a "-2147319779 Automation error. Library not registered". The error stops at the line "Set xl = New Excel.Application" which is shown below. I have no idea how to fix it. Any help would be greatly appreciated.
Thank you.
Phucon
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!frmTEST!txtFileSaveLocation.Value
strFilePath = Forms!frmTEST!lblPath.Caption
'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 Data"
'start a new recordset, assign dataset to recordset object
Set f = Forms!frmTEST
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 = 10
End With
xl.Columns.AutoFit
xl.Range("A1:A3").EntireRow.Insert
xl.Columns("G:G").Select
xl.Selection.NumberFormat = "$#,##0"
xl.Range("A1").FormulaR1C1 = "Financial Data as of: " & " " & Format(f.txtDate, "yyyymmdd")
xl.Rows("4:4").Font.ColorIndex = -4105
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
Resume ExitFunction
Resume
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