Private Sub cmdExport_Click()
'Check to see if State has a portal to upload to
Select Case gblnPortal
Case False
Exit Sub
Case True
End Select
msgApp = "Certified Payroll"
'Check to make sure state was selected
If IsNull(Me.cboState.Value) Then
msgText = "Please select a state from the list"
Response = MsgBox(msgText, vbOKOnly, msgApp)
Exit Sub
End If
'Dim dbs As dao.Database
'Dim qdf As dao.QueryDef
' Dim rst As dao.Recordset
If DCount("*", "qryMissingEmployees") > 0 Then
msgText = "Employees are Missing - Procedure Stopped"
Response = MsgBox(msgText, vbOKOnly, msgApp)
Exit Sub
End If
If DCount("*", "qryMissingJobs") > 0 Then
msgText = "Jobs are Missing - Procedure Stopped"
Response = MsgBox(msgText, vbOKOnly, msgApp)
Exit Sub
End If
If DCount("*", "qryMissingPublicBody") > 0 Then
msgText = "Public Body records are Missing - Procedure Stopped"
Response = MsgBox(msgText, vbOKOnly, msgApp)
Exit Sub
End If
dteStart = Me.StartDate
dteEnd = Me.EndDate
If IsNull(TempVars("StartDate") = "") Then
TempVars.Add "StartDate", dteStart
Else
TempVars!StartDate = dteStart
End If
If IsNull(TempVars("EndDate") = "") Then
TempVars.Add "EndDate", dteEnd
Else
TempVars!EndDate = dteEnd
End If
If IsNull(TempVars("State") = "") Then
TempVars.Add "State", gstrState
Else
TempVars!State = gstrState
End If
Dim strCriteria As String 'Date criteria to extract unique jobs
Select Case gstrState
Case "IL"
Illinois_Split
End Select
End Sub
Private Sub Illinois_Split()
Dim sDate As String
Dim lRecCount As Integer
'For renaming columns
Dim sFile As String
Dim sFieldNamesOrig As String, sFieldNamesTarget As String
Dim oApp As Excel.Application 'Excel Application
'dim oApp as Object 'you can remove the reference to Microsoft Excel xx.0 Object library)
Set oApp = CreateObject("Excel.Application") 'opens new instance of Excel
oApp.Visible = False 'for testing, you can see what Excel does, set to false when done
'Dim oWkbk As Object 'defines a workbook
Dim oWkbk As Excel.Workbook
oApp.DisplayAlerts = False 'turn off alerts
msgApp = "Certified Payroll"
'Extract Unique Jobs
strCriteria = "[Date] Between " & Format(dteStart, strcJetDate) & " And " & Format(dteEnd, strcJetDate) ' Setup Date Criteria
Set rsJobs = CurrentDb.OpenRecordset("SELECT DISTINCTROW Job FROM tblPWBenefits WHERE (" & strCriteria & ") GROUP BY Job ORDER BY Job;", dbOpenDynaset)
lRecCount = rsJobs.RecordCount
If lRecCount = 0 Then
msgApp = "Certified Payroll"
msgText = "No Jobs within that date period - Procedure Stopped"
Response = MsgBox(msgText, vbOKOnly, msgApp)
Exit Sub
End If
Dim FileName As String
Dim filenamePDF As String
Dim directoryName As String
sDate = Format(dteStart, "mmddyyyy")
dashdate = Format(dteStart, "mm-dd-yyyy")
directoryName = gExportPath & "\" & dashdate
'Make directory
If Not DirExists(directoryName) Then
MkDir (directoryName)
End If
TempVars.Add "StartDate", dteStart
TempVars.Add "EndDate", dteEnd
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Set dbs = CurrentDb
Do While Not rsJobs.EOF
Job = rsJobs!Job
'Set up from/to for Job Selection
''TempVars.Add "Job", Job 'for qryIllinoisPWExportPortal
''TempVars.Add "JobTo", Job 'Not being used, I don't think
TempVars.Add "JobStart", Job 'for qryIllinoisPWExport
TempVars.Add "JobEnd", Job
FileName = directoryName & "\State " & gstrState & " Job " & Job & " Start Date " & sDate & " - CP Upload.csv"
' DoCmd.TransferText acExportDelim, "QryIllinoisPWExportPortal Export Specification", "qryIllinoisPWExportPortal", filename, True
DoCmd.TransferText acExportDelim, "qryIllinoisPWExport Export Specification", "qryIllinoisPWExport", FileName, True
'Rename Columns
sFieldNamesOrig = Me.FieldNamesOriginal
sFieldNamesTarget = Me.FieldNamesTarget
sFile = FileName
'replace original with target
Call TextFile_FindReplace(sFile, sFieldNamesOrig, sFieldNamesTarget)
'Use Excel to save file in format IDOL Portal wants
With DoCmd
.SetWarnings False
Set oWkbk = oApp.WorkBooks.Open(sFile)
oWkbk.SaveAs sFile
oWkbk.Close
.SetWarnings True
End With
filenamePDF = directoryName & "\State " & gstrState & " Job " & Job & " Start Date " & sDate & " - CP Upload.pdf"
With DoCmd
.SetWarnings False
.OutputTo acOutputReport, "rptAffidavit", acFormatPDF, filenamePDF
.SetWarnings True
End With
DoCmd.Close acOutputReport, "rptAffidavit" '3-2-22
rsJobs.MoveNext
Loop
Set qdf = Nothing
Set dbs = Nothing
Set rsJobs = Nothing
' dbs.Close '3-2-22 error message
' rst.Close '3-2-22 error message
' rsJobs.Close '3-2-22
'Close Excel
Set oWkbk = Nothing
oApp.DisplayAlerts = True
Set oApp = Nothing
'oApp.Close '3-2-22
TempVars.RemoveAll
msgText = "Extract Completed, look at folder " & gExportPath & " for extracted CSV files"
Response = MsgBox(msgText, vbOKOnly, msgApp)
End Sub
Again, I have not used them in such an extensive way as you are in here, but it looks like a good place to start. For example in your cmdReportPDF_Click procedure why can't the report's (rptCPReport) recordsource reference the form controls directly instead of removing all tempvars and recreating them.
