Modifying Existing VBA to open file for yesterday not today

[ItalianPlatinum]

Hello - I have current VBA that a user helped me in a prior thread here. It will open a file based off partial parameters then open the most recent file. I have one curve ball now. I need to open the file for the prior business day as well (factoring holidays). The complexity of doing that has me little worried of how to approach. Would someone kindly assist?

Function OpenCopyST() As Workbook
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
  
    sPath = "\\XXXXXXXXXXXXXXXXXXXXXXXd\"      ' <<<<< change accordingly
  
    sPartial = "v_j_dist_periodic_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"
  
    sFName = Dir(sPath & sPartial)
    Dim arr() As Variant, FullName As String, i As Long
    Do While Len(sFName) > 0
        ReDim Preserve arr(i)
        arr(i) = sPath & sFName
        i = i + 1
        sFName = Dir
    Loop
    If i > 0 Then
        FullName = GetMostRecentFileFromArray(arr)

        Dim ErrNum As Long
        On Error Resume Next
        Workbooks.OpenText FullName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True

        ErrNum = VBA.Err.Number
        On Error GoTo 0
        If ErrNum = 0 Then
            Set OpenCopyST = ActiveWorkbook
        End If
    End If
End Function

Public Function GetMostRecentFileFromArray(ByRef argArr() As Variant) As String
    Dim fso As Object, i As Long, arrEntry As Long, oFile As Object, MostRecentFileDate As Double
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    For i = LBound(argArr) To UBound(argArr)
        Set oFile = fso.GetFile(argArr(i))
        If oFile.DateLastModified > MostRecentFileDate Then
            MostRecentFileDate = oFile.DateLastModified
            arrEntry = i
        End If
    Next i
    GetMostRecentFileFromArray = argArr(arrEntry)
End Function

 

[GWteB]

Replacing this snippet ...

   sPartial = "v_j_dist_periodic_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"

... with this one

    Dim Yesterday As Long
    Yesterday = Date - 1
 
    sPartial = "v_j_dist_periodic_" & Year(Yesterday) & IIf(Len(Month(Yesterday)) = 1, "0" & Month(Yesterday), Month(Yesterday)) & IIf(Len(Day(Yesterday)) = 1, "0" & Day(Yesterday), Day(Yesterday)) & "*.txt"

would do it.
Since I prefer separation of concerns and reuse of code your query could end up like this.

Function OpenCopyST_Yesterday() As Workbook

    Dim sPath       As String
    Dim sPartial    As String
    Dim sFullName   As String
    Dim Yesterday   As Long

    Yesterday = Date - 1

    sPath = "\\XXXXXXXXXXXXXXXXXXXXXXXd\"      ' <<<<< change accordingly

    sPartial = "v_j_dist_periodic_" & Year(Yesterday) & IIf(Len(Month(Yesterday)) = 1, "0" & Month(Yesterday), Month(Yesterday)) & IIf(Len(Day(Yesterday)) = 1, "0" & Day(Yesterday), Day(Yesterday)) & "*.txt"

    sFullName = GetMostRecentFileFromWildCardSpec(sPath, sPartial)
    OpenCopyST_Yesterday = OpenCopyST(sFullName)
End Function

Function OpenCopyST_Today() As Workbook

    Dim sPath       As String
    Dim sPartial    As String
    Dim sFullName   As String

    sPath = "\\XXXXXXXXXXXXXXXXXXXXXXXd\"      ' <<<<< change accordingly

    sPartial = "v_j_dist_periodic_" & Year(Date) & IIf(Len(Month(Date)) = 1, "0" & Month(Date), Month(Date)) & IIf(Len(Day(Date)) = 1, "0" & Day(Date), Day(Date)) & "*.txt"

    sFullName = GetMostRecentFileFromWildCardSpec(sPath, sPartial)
    OpenCopyST_Today = OpenCopyST(sFullName)
End Function


Public Function GetMostRecentFileFromWildCardSpec(ByVal argPath As String, ByVal argFileSpec As String) As String
    Dim FName As String, arr() As Variant, i As Long
    FName = Dir(argPath & argFileSpec)
    Do While Len(FName) > 0
        ReDim Preserve arr(i)
        arr(i) = argPath & FName
        i = i + 1
        FName = Dir
    Loop
    If i > 0 Then
        GetMostRecentFileFromWildCardSpec = GetMostRecentFileFromArray(arr)
    End If
End Function

Public Function OpenCopyST(ByVal argFullName As String) As Workbook
    Dim ErrNum As Long
    On Error Resume Next
    Workbooks.OpenText argFullName, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
    Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True
    
    ErrNum = VBA.Err.Number
    On Error GoTo 0
    If ErrNum = 0 Then
        Set OpenCopyST = ActiveWorkbook
    End If
End Function

Public Function GetMostRecentFileFromArray(ByRef argArr() As Variant) As String
    Dim fso As Object, i As Long, arrEntry As Long, oFile As Object, MostRecentFileDate As Double
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    For i = LBound(argArr) To UBound(argArr)
        Set oFile = fso.GetFile(argArr(i))
        If oFile.DateLastModified > MostRecentFileDate Then
            MostRecentFileDate = oFile.DateLastModified
            arrEntry = i
        End If
    Next i
    GetMostRecentFileFromArray = argArr(arrEntry)
End Function

 

[ItalianPlatinum]

My one question is if I run the prior one on a monday will it look for Sunday or Friday? I will obviously test on monday in live environment but I need a way to look at a prior business/week day

 

[GWteB]

If the code runs on a Monday, it will look for the file with the date of the previous Sunday in its file name.

I need a way to look at a prior business/week day as well (factoring holidays)

Every country has its special holidays, which are also often linked to a date instead of a weekday. It then becomes very complicated to automate all this.
I have some scenarios in mind which can be combined if desired:
1)
- if today is a Sunday or Monday, look for Friday's file;
- on any other day, look for the file from the previous day.
2)
- look for the file from the previous day anyway, regardless of its weekday;
- if this file does not exist, look for the file from the day before;
- repeat this until a file is found;
3)
- look for today's file;
- if this file has been processed, give the user the option to open the file from the previous day as well;
- and so on, until the user specifies that no more files need to be processed.

The code below acts on scenario 1.
Because some names of the dependencies have been changed I'll repost all used procedures for completeness.

Public Sub UsageExample()

    Dim wb As Workbook, SomeDate As Long, WkDay As VBA.VbDayOfWeek

    ' == SCENARIO 1 ==

    ' get today's weekday
    WkDay = VBA.Weekday(VBA.Date, vbSunday)

    Select Case WkDay
        Case vbSunday
            SomeDate = VBA.Date - 2  ' assign last Friday's date
        Case vbMonday
            SomeDate = VBA.Date - 3  ' assign last Friday's date
        Case Else
            SomeDate = VBA.Date - 1  ' assign yesterday's date
    End Select

    ' open required workbook and set a reference to it at the same time
    Set wb = OpenCopyST(SomeDate)

    If Not wb Is Nothing Then
    
        ' process workbook
    Else
        ' required workbook does not exist
    End If
End Sub


Public Function OpenCopyST(ByVal argSomeDate As Long) As Workbook

    Dim sPath As String, sPartial As String, sFullName As String, SomeDate As Long

    If argSomeDate > 0 Then
        
        sPath = "\\XXXXXXXXXXXXXXXXXXXXXXXd\"      ' <<<<< change accordingly
        sPartial = "v_j_dist_periodic_" & Year(argSomeDate) & IIf(Len(Month(argSomeDate)) = 1, "0" & Month(argSomeDate), Month(argSomeDate)) & IIf(Len(Day(argSomeDate)) = 1, "0" & Day(argSomeDate), Day(argSomeDate)) & "*.txt"

        sFullName = GetMostRecentFileFromWildCardSpec(sPath, sPartial)
        
        If VBA.Len(sFullName) > 0 Then
            Set OpenCopyST = OpenSpecificST(sFullName)
        End If
    End If
End Function

Public Function GetMostRecentFileFromWildCardSpec(ByVal argPath As String, ByVal argFileSpec As String) As String
    Dim FName As String, arr() As Variant, i As Long
    FName = Dir(argPath & argFileSpec)
    Do While Len(FName) > 0
        ReDim Preserve arr(i)
        arr(i) = argPath & FName
        i = i + 1
        FName = Dir
    Loop
    If i > 0 Then
        GetMostRecentFileFromWildCardSpec = GetMostRecentFileFromArray(arr)
    End If
End Function

Public Function OpenSpecificST(ByVal argFullName As String) As Workbook
    Dim ErrNum As Long
    On Error Resume Next
    Workbooks.OpenText argFullName, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
    Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True
    
    ErrNum = VBA.Err.Number
    On Error GoTo 0
    If ErrNum = 0 Then
        Set OpenSpecificST = ActiveWorkbook
    End If
End Function

Public Function GetMostRecentFileFromArray(ByRef argArr() As Variant) As String
    Dim fso As Object, i As Long, arrEntry As Long, oFile As Object, MostRecentFileDate As Double
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    For i = LBound(argArr) To UBound(argArr)
        Set oFile = fso.GetFile(argArr(i))
        If oFile.DateLastModified > MostRecentFileDate Then
            MostRecentFileDate = oFile.DateLastModified
            arrEntry = i
        End If
    Next i
    GetMostRecentFileFromArray = argArr(arrEntry)
End Function

 

[ItalianPlatinum]

You are correct each working day will have a file. weekends or holidays will not. User would not run this on a weekend. #1 or #2 sound best, where #2 seems easiest way to avoid issue with holidays i would assume

 

[GWteB]

The code for scenario #2 would look like this:

Public Sub Scenario2()

    Dim wb As Workbook, SomeDate As Long
    
    ' == SCENARIO 2 ==

    '- look for the file of the previous day anyway, regardless of its weekday;
    '- if that file does not exist, look for the file of the day before;
    '- repeat this until a file is found;

    ' today's date minus 1 targets yesterday
    SomeDate = VBA.Date - 1

    ' try opening the workbook of yesterday (or a day prior to yesterday)
    Do Until Not wb Is Nothing
        
        ' try opening required workbook and set a reference to it at the same time
        Set wb = OpenCopyST(SomeDate)
        If wb Is Nothing Then
            ' required workbook does not exist
            ' go one more day back
            SomeDate = SomeDate - 1
        Else
            ' process workbook
            ' after processing we're done
        End If
    Loop
End Sub

 

[ItalianPlatinum]

and i could still use the function you created to pull the most recent file when it looks at a prior day if there are multiple files?

Public Function GetMostRecentFileFromArray

 

[GWteB]

Yes, the Scenario2 procedure is a replacement for the UsageExample procedure. I didn't repost the other functions as of my post #4 but they still apply to this topic.

 

[ItalianPlatinum]

ok started testing will have some questions and post back

 

[ItalianPlatinum]

ok i made the the adjustments using scenario 2. so far i am falling down here with a compile error argument not optional

Dim ST As Workbook

Set ST = OpenCopyST

Public Function OpenCopyST(ByVal argSomeDate As Long) As Workbook

    Dim sPath As String, sPartial As String, sFullName As String, SomeDate As Long

    If argSomeDate > 0 Then
        
        sPath = "\\xxxxxxxxxxxx\"      ' <<<<< change accordingly
        sPartial = "xxxxx" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*."

        sFullName = GetMostRecentFileFromWildCardSpec(sPath, sPartial)
        
        If VBA.Len(sFullName) > 0 Then
            Set OpenCopyST = OpenSpecificST(sFullName)
        End If
    End If
End Function