Hello. Let me start off by saying I know very little about VBA, but I'm learning something new every day and I'm having fun with it. Now, I'm trying to Automate our database a little and get some queries to export to excel, the code below is what I have so far. I know this code will only do 1 query to 1 sheet, but I figure if I can get it working, I could mess around with it and get it to export multiple queries to mult. sheets. Right now this will bring up a new excel workbook and go to sheet 1, but it wont pull the query data. If someone could give me a hint, it would be appreciated. Thanks
Sub FunkyColdMedina()
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Const conMAX_ROWS = 20000
Const conSHT_NAME = "Sheet1"
Const conWKB_NAME = "workbook location"
Const conRANGE = ?
Set db = DBEngine.OpenDatabase("My database")
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("Query1", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
objSht.Range(conRANGE).CopyFromRecordset rs
End With
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
Sub FunkyColdMedina()
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Const conMAX_ROWS = 20000
Const conSHT_NAME = "Sheet1"
Const conWKB_NAME = "workbook location"
Const conRANGE = ?
Set db = DBEngine.OpenDatabase("My database")
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("Query1", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
objSht.Range(conRANGE).CopyFromRecordset rs
End With
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub