Need help populating data into excel using QueryDef

Tidy

Registered User.
Local time
Tomorrow, 00:46
Joined
May 9, 2011
Messages
16
I think I may have posted this in the wrong spot before. But here goes:

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.

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
 
I found a way to populate data using the ".CopyFromRecordSet" excel function. Does anyone know if there is any other way of doing this.
 

Users who are viewing this thread

Back
Top Bottom