Processing files generically in VBA

Option Compare Database
Option Explicit

Private Sub cboAsofDate_AfterUpdate()
Dim ReportDate As Date

ReportDate = CDate(Me.cboAsofDate.Value)
MsgBox "Filter for report date as of " & ReportDate
End Sub

Private Sub cboTransactionID_AfterUpdate()
Dim lngPKID As Long
lngPKID = Me.cboTransactionID.Value
'MsgBox "get exposures for id " & lngPKID

Dim qdf As QueryDef
Dim db As DAO.Database
Dim strSQL As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryODBCExposuregetAllPerTransactionId")
With qdf
    Debug.Print "Connect property=" & .Connect
    strSQL = "EXEC uspExposuregetAllPerTransactionID " & Me.cboTransactionID.Value
    .SQL = strSQL
    Debug.Print "Sql=" & strSQL
    .ReturnsRecords = True
End With

With Me.lstExposure

    .RowSource = ""
    .ColumnCount = 3
    .RowSourceType = "Table/query"
    .ColumnWidths = "1 in;2 in;2 in"
    .RowSource = "qryODBCExposuregetAllPerTransactionId"
   
    '.Requery
End With
End Sub

Private Sub cmdRefresh_Click()
Dim strMessage As String
Dim iNumberOfColumns As Integer
Dim qdf As QueryDef
Dim db As DAO.Database

If Me.cboDataAccessType = -1 Then
    MsgBox "Must select a data access type", vbInformation, "Confirm Action"
    Exit Sub
End If
    
If Me.cboDataAccessType.Value = "DAO" Then
    'MsgBox "Will refresh with DAO"
    Set db = CurrentDb()
    Set qdf = db.QueryDefs("qryStagingTableProgramFeeMainGetAll")
    With Me.lstData
        .RowSource = ""
        .RowSourceType = "Table/Query"
        .ColumnHeads = True
        .ColumnCount = qdf.Fields.Count
        .ColumnWidths = "2 in;2 in;2 in;2 in;2 in;2 ;2 in"
        .RowSource = qdf.Name
    End With
        
Else
    MsgBox "Will refresh with ADO"
End If



End Sub

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Option Compare Database
Option Explicit

Public Function OpeningForm(CloseForm As String, OpenForm As String)
DoCmd.Close acForm, CloseForm

DoCmd.OpenForm OpenForm, acNormal

End Function

Public Sub TestProcessFiles()
Call ProcessFiles(1)
End Sub
Public Function ProcessFiles(ByVal id As Integer)
Dim aFiles() As String
Dim objExcel As Excel.Application

Dim i As Integer
Dim bReturn As Boolean

Select Case id

    Case 1
        ReDim aFiles(0 To 0)
        'aFiles(1) = "Chase"
        aFiles(0) = "AMEX"
        
    Case Else
End Select


Set objExcel = New Excel.Application
For i = LBound(aFiles) To UBound(aFiles)
    
    bReturn = ProcessFile(objExcel, id, aFiles(i))
Next
Set objExcel = Nothing
        
ExitProc:
    ProcessFiles = bReturn
    Exit Function
    
ErrorHandler:
    
End Function

Public Function ProcessFile(objExcel As Excel.Application, id As Integer, ParamArray prm()) As Boolean
Dim bReturn As Boolean
Dim strInputPath As String
Dim strFileName As String
Const REPORT_NAME As String = "ProgramFeeAutoCalc"
Select Case id

    Case 1
       ' MsgBox "Processing " & strFileName
        strInputPath = CurrentProject.Path & "\Input\"
        strFileName = strInputPath & REPORT_NAME & "_" & prm(0) & ".xlsx"
        Debug.Print "Processing file " & strFileName & " @ " & Now()
        bReturn = ProgramFeeAccrualSave(objExcel, strFileName)
        If bReturn Then
            Debug.Print "Successfully processed file " & strFileName
        Else
            Debug.Print "Unsuccesfully processed file " & strFileName
        End If
    Case Else
End Select
    

Exit Function
    ProcessFile = bReturn
    
End Function


Private Function ProgramFeeAccrualSave(objExcel As Excel.Application, _
    ByVal strFileName As String) As Boolean

Const COL_DATE As Integer = 1
Const COL_REVENUE As Integer = 2
Const COL_COST As Integer = 3
Const COL_PROFIT As Integer = 4
'Dim objExcel As Excel.Application
Dim wb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim db As DAO.Database

Dim lngStartRow As Long
Dim lngRowCount As Long
Dim bReturn As Boolean
Dim rngAsofDate As Excel.Range
Dim rngClientID As Excel.Range
Dim lngClientID As Long
Dim asofDate As Date


Dim i As Long
Dim strMessage As String

Dim qdf As DAO.QueryDef



Set db = CurrentDb()
'Set objExcel = New Excel.Application
With objExcel
    Set wb = .Workbooks.Open(strFileName, ReadOnly:=True)
    'Set rngClientID = wb.Names("RNG_ClientID").RefersToRange.Value
    lngClientID = wb.Names("RNG_Clientid").RefersToRange.Value

    
    Set rngAsofDate = wb.Names("RNG_AsofDate").RefersToRange
    If IsDate(rngAsofDate.Value) Then
        asofDate = CDate(rngAsofDate.Value)
    End If
    
    
    Set wks = wb.Worksheets(1)
    lngRowCount = wb.Names("RNG_RowCount").RefersToRange.Value
    lngStartRow = wb.Names("RNG_RowStart").RefersToRange.Value
    Set qdf = db.QueryDefs("qryStagingTableProgramFeeMainDeleteAll")
    qdf.Execute
    
    Set qdf = Nothing
    
    
    Set qdf = db.QueryDefs("qryStagingTableProgramFeeMainAdd")
    With qdf
        .Parameters("Asofdate") = asofDate
        .Parameters("ClientID") = lngClientID
    End With
    
    For i = lngStartRow To lngStartRow + lngRowCount - 1
    
        strMessage = "No " & i - lngStartRow - 1 & " " & "Date=" & CStr(wks.Cells(i, COL_DATE)) & " " & _
            "Profit=" & CStr(wks.Cells(i, COL_PROFIT))
        With qdf
            .Parameters("txtReportDate") = CStr(wks.Cells(i, COL_DATE).Value)
            .Parameters("txtAmount") = CStr(wks.Cells(i, COL_PROFIT).Value)
            .Parameters("RowNumber") = i - lngStartRow
            .Parameters("AddedBy") = "System"
        End With
        qdf.Execute
            
            
        Debug.Print strMessage
    Next
    
    wb.Close
End With

bReturn = True
ExitProc:
    On Error Resume Next
    ProgramFeeAccrualSave = bReturn
    Set wks = Nothing
    Set wb = Nothing
    Set objExcel = Nothing
    Set qdf = Nothing
    Set db = Nothing
    Exit Function
    
End Function