Tarry Singh
asked on
VBA code wouldn't populate data when creating workbooks
I need to populate templates while using a access form. THis VBA coding was done by an ex-employee, I have made changes to it so that it can use latest data to populate templates. All the queries referred in the code are working fine but somehow procedure creates empty workbooks (no population of data). Here is some of the coding for reference (I can send you the whole code if you email me at tarrysingh15@gmail.com):
ublic Function ExportRequest() As String
On Error GoTo err_Handler
' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sTemplate As String, sWorkbook As String
Dim TabName As String
Dim CourtNum As Byte, FY As String, FYnum As Integer
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef, qdf1a1 As DAO.QueryDef, qdf1a2 As DAO.QueryDef, qdf2 As DAO.QueryDef, qdf3 As DAO.QueryDef, qdf4 As DAO.QueryDef, qdf5 As DAO.QueryDef, qdf6 As DAO.QueryDef
Dim qdf7a As DAO.QueryDef, qdf7b As DAO.QueryDef, qdf7c As DAO.QueryDef ', qdf7d As DAO.QueryDef
Dim qdf8a As DAO.QueryDef, qdf8b As DAO.QueryDef, qdf8c As DAO.QueryDef, qdf8d As DAO.QueryDef, qdf8e As DAO.QueryDef
Dim qdf9a As DAO.QueryDef, qdf9b As DAO.QueryDef, qdf9c As DAO.QueryDef, qdf10 As DAO.QueryDef
Dim rst As DAO.Recordset
Dim lRecords As Long
Dim iRow As Long, fundRow As Long, costcenterRow As Long, iCol As Long
Dim tctfCol As Byte, ntctfCol As Byte
Dim CourtName As String
DoCmd.Hourglass True
For CourtNum = Forms!frmICRPpopulation171 8TS!cboCou rtFirst To Forms!frmICRPpopulation171 8TS!cboCou rtLast
Me.lblMsg.Caption = "running query"
Me.Repaint
' identify the template file
FY = "FY1718"
sTemplate = "G:\Budget Services\17-18 Budget Services\Indirect Cost Rate Proposal (ICRP)\Template\00-CourtIC RP1718.xls x"
If CourtNum < 10 Then
sWorkbook = "G:\Budget Services\17-18 Budget Services\Indirect Cost Rate Proposal (ICRP)\To Courts\C0" & CourtNum & "ICRP1718.xlsx"
Else
sWorkbook = "G:\Budget Services\17-18 Budget Services\Indirect Cost Rate Proposal (ICRP)\To Courts\C" & CourtNum & "ICRP1718.xlsx"
End If
On Error GoTo err_Handler
' Create the Excel Application, open the ICRP template
Set appExcel = CreateObject("Excel.Applic ation")
' appExcel.Visible = True
Set wbk = appExcel.Workbooks.Open(sT emplate)
appExcel.ActiveWorkbook.Sa veAs Filename:=sWorkbook
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("qryCourtNam e")
Set qdf1a1 = dbs.QueryDefs("qry1a1")
Set qdf1a2 = dbs.QueryDefs("qry1a2")
Set qdf2 = dbs.QueryDefs("qry3a")
Set qdf3 = dbs.QueryDefs("qry5a")
Set qdf4 = dbs.QueryDefs("qry5b")
Set qdf5 = dbs.QueryDefs("qry6")
Set qdf6 = dbs.QueryDefs("qryICRPws")
Set qdf7a = dbs.QueryDefs("qryQFSd16")
Set qdf7b = dbs.QueryDefs("qryQFSd18")
Set qdf7c = dbs.QueryDefs("qryQFSd23")
'Set qdf7d = dbs.QueryDefs("qryQFSd26")
Set qdf8a = dbs.QueryDefs("qry7a")
Set qdf8b = dbs.QueryDefs("qry7b")
Set qdf8c = dbs.QueryDefs("qry7c")
Set qdf8d = dbs.QueryDefs("qry7d")
Set qdf8e = dbs.QueryDefs("qry7e")
Set qdf9a = dbs.QueryDefs("qryFTEfille dDirect&In direct1718 TS")
Set qdf9b = dbs.QueryDefs("qrySch1ExpF orICRPtab6 General")
Set qdf9c = dbs.QueryDefs("qrySch1ExpF orICRPtab6 SpecialRev ")
Set qdf10 = dbs.QueryDefs("qryFTEfille dDirect&In direct1516 TS")
' Tab 1
TabName = "TAB 1-ICRP Calculation Form"
qdf.Parameters(0) = CourtNum
Set rst = qdf.OpenRecordset
If rst.EOF = True Then GoTo 4
If Not rst.BOF Then rst.MoveFirst
CourtName = rst.Fields(1)
Set wks = appExcel.Worksheets(TabNam e)
wks.Activate
wks.Unprotect Password:="joan"
lRecords = lRecords + 1
Me.lblMsg.Caption = "Exporting record #" & lRecords & " to FY 2017-18 ICRP workbook"
Me.Repaint
wks.Cells(6, 2) = "COUNTY OF: " & CourtName
wks.Cells.Locked = True
wks.Protect Password:="joan"
4 rst.Close
Set rst = Nothing
ublic Function ExportRequest() As String
On Error GoTo err_Handler
' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sTemplate As String, sWorkbook As String
Dim TabName As String
Dim CourtNum As Byte, FY As String, FYnum As Integer
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef, qdf1a1 As DAO.QueryDef, qdf1a2 As DAO.QueryDef, qdf2 As DAO.QueryDef, qdf3 As DAO.QueryDef, qdf4 As DAO.QueryDef, qdf5 As DAO.QueryDef, qdf6 As DAO.QueryDef
Dim qdf7a As DAO.QueryDef, qdf7b As DAO.QueryDef, qdf7c As DAO.QueryDef ', qdf7d As DAO.QueryDef
Dim qdf8a As DAO.QueryDef, qdf8b As DAO.QueryDef, qdf8c As DAO.QueryDef, qdf8d As DAO.QueryDef, qdf8e As DAO.QueryDef
Dim qdf9a As DAO.QueryDef, qdf9b As DAO.QueryDef, qdf9c As DAO.QueryDef, qdf10 As DAO.QueryDef
Dim rst As DAO.Recordset
Dim lRecords As Long
Dim iRow As Long, fundRow As Long, costcenterRow As Long, iCol As Long
Dim tctfCol As Byte, ntctfCol As Byte
Dim CourtName As String
DoCmd.Hourglass True
For CourtNum = Forms!frmICRPpopulation171
Me.lblMsg.Caption = "running query"
Me.Repaint
' identify the template file
FY = "FY1718"
sTemplate = "G:\Budget Services\17-18 Budget Services\Indirect Cost Rate Proposal (ICRP)\Template\00-CourtIC
If CourtNum < 10 Then
sWorkbook = "G:\Budget Services\17-18 Budget Services\Indirect Cost Rate Proposal (ICRP)\To Courts\C0" & CourtNum & "ICRP1718.xlsx"
Else
sWorkbook = "G:\Budget Services\17-18 Budget Services\Indirect Cost Rate Proposal (ICRP)\To Courts\C" & CourtNum & "ICRP1718.xlsx"
End If
On Error GoTo err_Handler
' Create the Excel Application, open the ICRP template
Set appExcel = CreateObject("Excel.Applic
' appExcel.Visible = True
Set wbk = appExcel.Workbooks.Open(sT
appExcel.ActiveWorkbook.Sa
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("qryCourtNam
Set qdf1a1 = dbs.QueryDefs("qry1a1")
Set qdf1a2 = dbs.QueryDefs("qry1a2")
Set qdf2 = dbs.QueryDefs("qry3a")
Set qdf3 = dbs.QueryDefs("qry5a")
Set qdf4 = dbs.QueryDefs("qry5b")
Set qdf5 = dbs.QueryDefs("qry6")
Set qdf6 = dbs.QueryDefs("qryICRPws")
Set qdf7a = dbs.QueryDefs("qryQFSd16")
Set qdf7b = dbs.QueryDefs("qryQFSd18")
Set qdf7c = dbs.QueryDefs("qryQFSd23")
'Set qdf7d = dbs.QueryDefs("qryQFSd26")
Set qdf8a = dbs.QueryDefs("qry7a")
Set qdf8b = dbs.QueryDefs("qry7b")
Set qdf8c = dbs.QueryDefs("qry7c")
Set qdf8d = dbs.QueryDefs("qry7d")
Set qdf8e = dbs.QueryDefs("qry7e")
Set qdf9a = dbs.QueryDefs("qryFTEfille
Set qdf9b = dbs.QueryDefs("qrySch1ExpF
Set qdf9c = dbs.QueryDefs("qrySch1ExpF
Set qdf10 = dbs.QueryDefs("qryFTEfille
' Tab 1
TabName = "TAB 1-ICRP Calculation Form"
qdf.Parameters(0) = CourtNum
Set rst = qdf.OpenRecordset
If rst.EOF = True Then GoTo 4
If Not rst.BOF Then rst.MoveFirst
CourtName = rst.Fields(1)
Set wks = appExcel.Worksheets(TabNam
wks.Activate
wks.Unprotect Password:="joan"
lRecords = lRecords + 1
Me.lblMsg.Caption = "Exporting record #" & lRecords & " to FY 2017-18 ICRP workbook"
Me.Repaint
wks.Cells(6, 2) = "COUNTY OF: " & CourtName
wks.Cells.Locked = True
wks.Protect Password:="joan"
4 rst.Close
Set rst = Nothing
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
No replies from the asker