Excel VBA-查找具有变量名的文件（工作日函数）

Question

I have a script that, among other things, loads files with variable file names corresponding to dates. It can load dates within the last 7 days fine, however, I need it to load dates past that.

The script will be run on Friday mornings, and I need it to pull the entire week, plus entire previous week. Currently, it will pull the previous Friday (7 days ago) up through the previous day (Thursday).

What I need is the correct code to get it to pull last Monday through last Thursday.

The code to pull last Monday is below. I have tried changing Date - 1 to Date - 2, but that is not right. I know that vbMonday is supposed to correspond to a date within the last 7 days (if I understand correctly. Probably a simple thing I am missing, but no option seems to work.

(FYI all variables are declared, just omitted so it is easier to see what is happening)

LastMondayDate = Format(Date - (Weekday(Date - 1, vbMonday)), "m.d.yy")
fullFileNameLastMonday = strFilePath & LastMondayDate & ".xls"
If Dir(fullFileNameLastMonday) = "" Then
    MsgBox "File for last Monday doesn't exist!"
    GoTo ExitLastMonday
End If
Set wbkLastMonday = Workbooks.Open(fullFileNameLastMonday, False, True)
.......Do stuff.......
wbkLastMonday.Close SaveChanges:=False

ExitLastMonday:

Answer 1

You can try something like this:

Public Sub LoveMondays()

    Dim i As Long

    For i = 1 To 15
        Debug.Print DateAdd("ww", i * -1, Date - (Weekday(Date, vbMonday) - 1))
    Next i

End Sub

It gives the dates of the last 15 Mondays. Then, if applicable, a function of the Debug.Print with i as an input variable would be useful.

Eg:

Public Function MondaysWeekBack(lngWeekBack As Long) As Date
    MondaysWeekBack = DateAdd("ww", lngWeekBack * -1, Date - (Weekday(Date, vbMonday) - 1))
End Function

Thus for the current week, you can get the Monday like this: MondaysWeekBack(0) and for the previous MondaysWeekBack(1) .

Here is the Microsoft reference of DateAdd - https://msdn.microsoft.com/en-us/library/hcxe65wz(v=vs.90).aspx

Edit: As suggested in the comment by @Robin Mackenzie, the function could be extended to make the day a variable as well. Like this:

Public Function WeekdayWeekBack(lngWeekBack As Long, _ 
                       Optional lngWeekday As Long = 2) As Date

    WeekdayWeekBack = DateAdd("ww", lngWeekBack * -1, Date - (Weekday(Date, lngWeekday) - 1))
End Function

Then if we want the last Sunday, we should go like this WeekdayWeekBack(0,1) or WeekdayWeekBack(0,vbSunday) . Monday is by default, thus WeekdayWeekBack(0) would give us the last Monday.

Answer 2

The Weekday function returns a number between 1 and 7 representing the 7 days of the week. Weekday(Date, vbMonday) specifies that Monday will be the day which has the number 1, the first day of the week. Weekday(Date - 1, vbMonday) will always specify a Monday. To specify another day change the -1 in the formula.

Date - Weekday(Date - 1, vbMonday) specifies the same day for 7 days in a row because as the date advances (+ 1 every day) so does the Weekday which is subtracted from it. From Tuesday until Monday next week it will specify the current week's Monday. Then it will jump to the next Monday.

In order to capture a Monday which is earlier, just modify the date component. Date - 7 - Weekday(Date - 1, vbMonday) will do exactly the same as just described but 7 days further in the past.

Answer 3

Here try this

Private Sub that()

    Dim LastDate As Date
    Dim NewDate As Date
    Dim path As String
    Dim filename As String


        Select Case Weekday(Now())
            Case Is = 2
                LastDate = Format(DateAdd("d", -14, Date), "mm-dd-yyyy")
            Case Is = 3
                LastDate = Format(DateAdd("d", -14, Date), "mm-dd-yyyy")
            Case Is = 4
                LastDate = Format(DateAdd("d", -15, Date), "mm-dd-yyyy")
            Case Is = 5
                LastDate = Format(DateAdd("d", -16, Date), "mm-dd-yyyy")
            Case Is = 6
                LastDate = Format(DateAdd("d", -18, Date), "mm-dd-yyyy")
        End Select

        NewDate = LastDate + 11
        path = "" & "\"
        filename = Dir(path & "*.xl??")

         Do While Len(filename) > 0
            this = Mid(filename, InStrRev(filename, "\") + 1, InStrRev(filename, "."))
            this = Left(this, InStr(this, ".") - 1)
            If CDate(this) >= LastDate And CDate(this) <= NewDate Then
                ' do your stuff
            End If
         Loop
End Sub

This can be run any day of the week and gets the last two previous weeks. The section where it says "'do your stuff" is where you'd put the body of your action code. I did some string manipulation, forced them to date values with a check that sees if the current file is within the date range you want to check for. This isnt tested but I am 100% on it working. Also, you'll need to set the path variable, but i am sure its 100%==to strFilePath.

Answer 4

I think it would be easier to change the code from LastMondayDate, LastTuesdayDate, LastWednesdayDate to something much easier: FirstDayToGet. Please note below is only the logic. This logic will open all the date-files you need from the starting date to the current date - or alternatively you could add an ending date if current date is too broad

Sub logicOnlyNotActualCode()
FirstDayToGet = datepicker or textbox value date or cell value date
toooooday = date() ' or some end date

for I = FirstDayToGet to FirstDayToGet + (toooooday - FirstDayToGet)
    run get_date_report(FirstDayToGet)
    FirstDayToGet = dateAdd("d",1,FirstDayToGet)
next i
End Sub

And your function would look something like:

function get_date_report(FirstDayToGet as date)
dim get_report as string
    get_report = strFilePath & Format(FirstDayToGet , "m.d.yy")  & ".xls"

Do events
End function

Answer 5

This function returns the date values from numDays days ago, up through yesterday's date, inclusive. It does not account for exceptions like holidays or weekends, etc. What you should do is use this function to build the filenames, and then use the Dir function to test for presence of the file, and (obviously) if the file not exist, do not attempt to open or process it, just move on to the next iteration.

Function GetFileNames(numDays As Long, optional dFormat as String = "m.d.yy")
'Function returns a string array (len = numDays) of formatted date values
'beginning from numDays days ago, until yesterday's date.
ReDim filenames(1 To numDays) As String
Dim LastDate As Date, i As Long

LastDate = Date 'Returns TODAY's date
'Use DateAdd function to calculate the last numDays:
For i = 1 To numDays
    filenames(i) = Format(DateAdd("d", -(numDays) + i - 1, LastDate), dFormat)
Next

GetFileNames = filenames
End Function

Here is a way you can test it:

Sub TestMe()
Dim a
a = GetFileNames(1) 'Should return an array of len=1, yesterday's date only
MsgBox a(1) 
a = GetFileNames(14) 'Should return an array of len=14, fourteen days prior to and including Yesterday

End Sub

This is how you get all 14 filenames without creating 14 variable/workbook objects:

Dim dateVals 
dateVals = GetFileNames(14)

Now, do something with the array (like open the corresponding workbooks and process them somehow:

Dim val, Dim wb as Workbook
For Each val in DateVals
    If Dir(strFilePath & val & ".xls") <> "" Then
        Set wb = Workbooks.Open(strFilePath & val & ".xls")
        'Do something with the workbook
        wb.Close
    End If
Next