Link to home
Start Free TrialLog in
Avatar of Tarry Singh
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!frmICRPpopulation1718TS!cboCourtFirst To Forms!frmICRPpopulation1718TS!cboCourtLast
   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-CourtICRP1718.xlsx"
   
   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.Application")
   ' appExcel.Visible = True
   Set wbk = appExcel.Workbooks.Open(sTemplate)
   appExcel.ActiveWorkbook.SaveAs Filename:=sWorkbook
   Set dbs = CurrentDb
   Set qdf = dbs.QueryDefs("qryCourtName")
   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("qryFTEfilledDirect&Indirect1718TS")
   Set qdf9b = dbs.QueryDefs("qrySch1ExpForICRPtab6General")
   Set qdf9c = dbs.QueryDefs("qrySch1ExpForICRPtab6SpecialRev")
   Set qdf10 = dbs.QueryDefs("qryFTEfilledDirect&Indirect1516TS")
               
   ' 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(TabName)
   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
Avatar of Fabrice Lambert
Fabrice Lambert
Flag of France image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
No replies from the asker