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
").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
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

.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