Hi Everyone,
I was hoping someone in this Forum with a bit more Savy than me which would take much at all, could solve why can't get the following VBA to work or even better yet give me a working .. example.mdb, Story is so far after searching and google all the common suggestions, I am still baffled as to why it throws an error I think this is mainly because i suffer from dyslexia and I just can't get my head around how to initialize this ie. From Cradle to Grave.
I have used WITH success the VBA on liner version
Code:
DoCmd.OutputTo acOutputForm, "frm_Test", acFormatXLS, _
"C:\Users\Me\Desktop\ExportedResults.xls"
with success, but the output looks awful to say the least, so I am hoping that I may have better control over the formatting of the outputs look and feel in excel whenever if ever this gets up and running.
So I am basically looking for some help in layman's terms(english) as in baby steps please
The below code stops at the line
Code:
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
and give me this error message : active X componant can't create object! I know what an object is and as far as I can tell the below code attempts to do this?
So far, I have disabling all the Coms that google suggested! and checked and unchecking all the general settings boxs within the Access >Options and still it doesn't work, I have also been into the references and anything that even resembles the word script, or Active X I have enabled.
Could it be there something in the code that is at fault or what?? if its not the code could someone provide me with a simple working demo?
Many thanks for taking the time to read.
curtisy of
HTML Code:
https://www.devhut.net/2017/03/15/ms-access-vba-export-recordset-to-excel/
Code:
'
'---------------------------------------------------------------------------------------
' Procedure : ExportRecordset2XLS
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Export the passed recordset to Excel
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' rs : Recordset object to export to excel
'
' Usage:
' ~~~~~~
' Call ExportRecordset2XLS(Me.RecordsetClone)
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2017-Mar-13 Initial Release
'---------------------------------------------------------------------------------------
Function ExportRecordset2XLS_1st(ByVal rs As DAO.Recordset)
#Const EarlyBind = True 'Use Early Binding, Req. Reference Library
'#Const EarlyBind = False 'Use Late Binding
#If EarlyBind = True Then
'Early Binding Declarations
Dim oExcel As New Excel.Application
Dim oExcelWrkBk As New Excel.Workbook
Dim oExcelWrSht As New Excel.Worksheet
#Else
'Late Binding Declaration/Constants
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim oExcelWrSht As Object
Const xlCenter = -4108
#End If
Dim bExcelOpened As Boolean
Dim iCols As Integer
'Start Excel
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
'Set oExcel = CreateObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oExcel = CreateObject("Excel.Application")
bExcelOpened = False
Else 'Excel was already running
bExcelOpened = True
End If
On Error GoTo Error_Handler
oExcel.ScreenUpdating = False
oExcel.Visible = False 'Keep Excel hidden until we are done with our manipulation
Set oExcelWrkBk = oExcel.Workbooks.Add() 'Start a new workbook
Set oExcelWrSht = oExcelWrkBk.Sheets(1)
With rs
If .RecordCount <> 0 Then
.MoveFirst 'This is req'd, had some strange behavior in certain instances without it!
'Build our Header
'****************
For iCols = 0 To rs.Fields.count - 1
oExcelWrSht.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
'Format the header
With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
oExcelWrSht.Cells(1, iCols))
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
.HorizontalAlignment = xlCenter
End With
'Copy the data from our query into Excel
'***************************************
oExcelWrSht.Range("A2").CopyFromRecordset rs
'Some formatting to make things pretty!
'**************************************
'Freeze pane
oExcelWrSht.Rows("2:2").Select
With oExcel.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
'AutoFilter
oExcelWrSht.Rows("1:1").AutoFilter
'Fit the columns to the content
oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
oExcelWrSht.Cells(1, iCols)).EntireColumn.AutoFit
'Start at the top
oExcelWrSht.Range("A1").Select
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", _
vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
Error_Handler_Exit:
On Error Resume Next
oExcel.Visible = True 'Make excel visible to the user
Set rs = Nothing
Set oExcelWrSht = Nothing
Set oExcelWrkBk = Nothing
oExcel.ScreenUpdating = True
Set oExcel = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ExportRecordset2XLS" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function