automation error

qwertyjjj

Registered User.
Local time
Yesterday, 19:26
Joined
Aug 8, 2006
Messages
262
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?

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
 

Users who are viewing this thread

Back
Top Bottom