Need help populating data into excel using QueryDef

Tidy

Registered User.
Local time
Tomorrow, 00:58
Joined
May 9, 2011
Messages
16
Good Morning Everyone,
Can any one tell how to pull information from a QueryDef and make it populate into fields in excel. I have all of the code working up into this point but I do not know how to add the information. Below is the code that I am using.
Code:
Public Sub ASFFPull()
Dim dbs As DAO.Database
Dim myBookName As String
 
Dim objExcel As Excel.Application
Dim objxlBook As Excel.Workbook
Dim objxlSheet As Excel.Worksheet
 
Dim lngCounter As Long
Dim lngRow As Long
 
Dim strSQL_Bag As String
Dim strQuery_Bag As String
Dim qryDef_Bag As QueryDef
Dim rst_Bag As DAO.Recordset
 
 
Set dbs = CurrentDb
 
'Open Excel and create new workbook
Set objExcel = Excel.Application
Set objxlBook = objExcel.Workbooks.Add
Set objxlSheet = objExcel.Worksheets(1)
 
'Show Excel and create caption name
With objExcel
.Visible = True
.Caption = "Status Of Funds Summary Chart FY 10"
.DisplayAlerts = False
End With
 
 
objxlSheet.Name = "test"
 
'Turn On Hourglass
DoCmd.Hourglass False
 
'Create File Name
myBookName = "N:\Local & Conus Database\SOFSC" & "\" & "Status Of Funds Summary Chart FY 10, " & _
Format(Now(), "MMM D YYYY") & ".xls"
 
'Do An Initital Save
objxlBook.SaveAs myBookName, xlNormal
 
 
 
'**** **** **** **** **** **** Make "ASFF FUNDS FY10" Tab **** **** **** **** **** ****
objxlBook.Worksheets(1).Activate
Set objxlSheet = objxlBook.Sheets.Add
objxlSheet.Name = "ASFF Funds FY10"
 
 
 
'Set Column Width and Row Height
With objxlSheet
.Columns("A:A").ColumnWidth = 1
.Columns("B:B").ColumnWidth = 5.14
.Columns("C:C").ColumnWidth = 12.29
.Columns("D:D").ColumnWidth = 13
.Columns("E:E").ColumnWidth = 13
.Columns("F:F").ColumnWidth = 13
.Columns("G:G").ColumnWidth = 13
.Columns("H:H").ColumnWidth = 16.29
.Columns("I:I").ColumnWidth = 14
.Columns("J:J").ColumnWidth = 13.71
.Columns("K:K").ColumnWidth = 13
.Rows(1).RowHeight = 39
End With
 
'ROW 1: Set Workbook and Format Header
With objxlSheet
.Range("B1:K1").Interior.Color = vbBlue
.Range("B1:K1").HorizontalAlignment = xlCenter
.Range("B1:K1").Merge (True)
.Cells(1, 2) = "ASFF STATUS OF FUNDS FY10 (AS OF " & Format(Now(), "D MMM YYYY") & ")"
.Cells(1, 2).Font.Bold = True
.Cells(1, 2).Font.Size = 26
.Cells(1, 2).Font.Color = vbWhite
End With
 
'ROW 2: Set Conus Funds Header
With objxlSheet
.Range("B2:K2").Interior.Color = vbYellow
.Range("B2:K2").HorizontalAlignment = xlCenter
.Range("B2:K2").Merge (True)
.Cells(2, 2) = "CONUS(DSCA)"
.Cells(2, 2).Font.Bold = True
.Cells(2, 2).Font.Size = 11
.Cells(2, 2).Font.Color = vbBlack
End With
 
'ROW 3: Set Category Headings And Format
With objxlSheet
.Range("B3:K3").Font.Bold = True
.Range("B3:K3").Font.Size = 10
.Range("B3:K3").HorizontalAlignment = xlCenter
.Cells(3, 2) = "Bag"
.Cells(3, 3) = "Sag"
.Cells(3, 4) = "Authority"
.Cells(3, 5) = "Obligation"
.Cells(3, 6) = "%Obligated"
.Cells(3, 7) = "Commitments"
.Cells(3, 8) = "Pending LOA"
.Cells(3, 9) = "Gross Commits"
.Cells(3, 10) = "%GComm"
.Cells(3, 11) = "Available"
End With
 
'Create CONUS Bag********************************
 
 
 
'Name Temp Query String
strQuery_Bag = "Temp_xlBag"
 
'Create SQL Text For Query
strSQL_Bag = "SELECT [Status Of Funds Combined Local].Bag " & _
"FROM [Status Of Funds Combined Local] " & _
"WHERE [Status Of Funds Combined Local].Bag " & _
"GROUP BY [Status Of Funds Combined Local].Bag;"
 
 
'Create Query
Set qryDef_Bag = dbs.CreateQueryDef(strQuery_Bag, strSQL_Bag)
 
'Open the Recordset
Set rst_Bag = dbs.QueryDefs(strQuery_Bag).OpenRecordset
 
With objxlSheet
 
 
 
'Delete "Temp_xlBag"
dbs.QueryDefs.Delete "Temp_xlBag"
 
 
'Turn Off Hourglass
DoCmd.Hourglass False
 
 
'Make "Sheet1" the active sheet ***************************
'objxlBook.Worksheets(1).Activate
 
'Delete "Sheet1" Worksheet
'objExcel.DisplayAlerts = False
'objxlBook.Worksheets(1).Activate
'objxlBook.Worksheets(1).Delete
'objExcel.DisplayAlerts = True
 
'Final Save
objxlBook.Save
 
'Destroy connections
Set objExcel = Nothing
Set objxlBook = Nothing
Set objxlSheet = Nothing
Set dbs = Nothing
 
 
 
 
End Sub
 
Last edited by a moderator:
Do you need to push it to Exce or can you pull it in from Excel?

If you can try using the MSQuery tool. you can pull in query results to Excel with it and whenever you nneed new data you just need to select "refresh" in Excel
 
Use code tags next time you post code (especially long bits of code).

codetag001.png
 
Question - why a querydef? Are you modifying the query at runtime? If not, just use a standard select statement in conjunction with a recordset object and iterate through if the field values have to go in specific places.
 
Yes, it is modified every time it is run based on form selections. The form uses data from 2 combo lists and 12 checkboxes to generate the criteria statements for the query each time it runs.

It is for drilling down into large amounts of customer data (several hundred thousand indiivdual accoiunt records) to pull it up in a way the managers can understand it.
 
Thanks for the feedback. I got the queries to pull data from my access database into excel using the copyRecordset function. I am using the qryDef so I can delete the data to free up space. I am having to pull serveral queries into this spreadsheet to get all the data I need.
 
sorry about that I mean "copyFromRecordSet"
 

Users who are viewing this thread

Back
Top Bottom