I'm getting an auotmation error when exporting data to Excel.
This code all worked before and then I installed Access 2007.
I still have 2003 at the same time and the db is in 2003.
Microsoft site says that the automation error happens in older versions of Excel so I outputted a message box to get the version and it says 11.
MsgBox (Val(Mid(oApp.Version, 1, InStr(1, oApp.Version, ".") - 1)))
oSheet.Range("A2").CopyFromRecordset MyRS
It still fall ove ron the copyfromrecordset part.
Know anything to check?
This code all worked before and then I installed Access 2007.
I still have 2003 at the same time and the db is in 2003.
Microsoft site says that the automation error happens in older versions of Excel so I outputted a message box to get the version and it says 11.
MsgBox (Val(Mid(oApp.Version, 1, InStr(1, oApp.Version, ".") - 1)))
oSheet.Range("A2").CopyFromRecordset MyRS
It still fall ove ron the copyfromrecordset part.
Know anything to check?
Code:
Private Sub cmbChooseCC_AfterUpdate()
Dim iNumCols As Integer
Dim varcc As String
Dim MyDb As Database, MyQry As querydef, MyRS As Recordset
varcc = Me.cmbChooseCC
Set MyDb = CurrentDb()
Set MyQry = MyDb.CreateQueryDef("")
' Type a connect string using the appropriate values for your
' server.
MyQry.Connect = connection
' Set the SQL property and concatenate the variables.
MyQry.SQL = "EXEC LedgerReport '" & varcc & "'"
MyQry.ReturnsRecords = True
Set MyRS = MyQry.OpenRecordset()
'get the number of records so we can use it in any automation of the Excel spreadsheet
MyRS.MoveLast
iCount = MyRS.RecordCount
MyRS.MoveFirst
'Set rs = CurrentDb.OpenRecordset("Query1")
Application.SetOption "Show Status Bar", True
StatusBar = SysCmd(acSysCmdSetStatus, "Formatting export file... please wait.")
'Start a new workbook in Excel
Dim oApp As New Excel.Application
Dim oBook As Excel.workBook
Dim oSheet As Excel.workSheet
'uncomment these 2 lines for debugging
oApp.Visible = True
oApp.UserControl = True
Set oBook = oApp.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
'Add the field names in row 1
iNumCols = MyRS.Fields.Count
For i = 1 To iNumCols
oSheet.Cells(1, i).Value = MyRS.Fields(i - 1).Name
Next
'Add the data starting at cell A1
MsgBox (Val(Mid(oApp.Version, 1, InStr(1, oApp.Version, ".") - 1)))
oSheet.Range("A2").CopyFromRecordset MyRS
With oSheet
'put cursor into first cell
.Cells(1, iNumCols + 1) = "Amount"
End With
For numCount = 2 To iCount + 1
oSheet.Cells(numCount, iNumCols + 1).FormulaR1C1 = "=IF(R[0]C[-12]=R[-1]C[-12],"""",R[0]C[-2])"
Next
With oSheet
.Range("A1").Select
.Rows("1:1").Font.Bold = True
.Cells.EntireColumn.AutoFit
End With
'--------------------------------------
'Tidy up
'--------------------------------------
oApp.Visible = True
oApp.UserControl = True
'Close the Recordset
MyRS.Close
Set MyRS = Nothing
Set MyDb = Nothing
Set MyQry = Nothing
Set oBook = Nothing
Set oSheet = Nothing
Set oApp = Nothing
vStatusBar = SysCmd(acSysCmdClearStatus)
DoCmd.Close acForm, "frmChooseCC"
End Sub