Получить последний файл в прошлом году в прошлом месяце Папка с использованием Excel 2016

Question

У меня есть скрипт, который получает последний файл из папки и сохраняет его с текущей датой для ежедневных отчетов. Однако проблема, с которой я столкнулся в этом месяце, заключается в том, что мой сценарий не может просмотреть декабрь прошлого года и получить последний файл в этой папке. Я должен был вручную скопировать файл. Может ли кто-нибудь помочь мне с моим сценарием.

Dim WB1 As Workbook
Dim WB2 As Workbook
Dim oPath As String
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Dim oPath2 As String
' Turn off Display Alerts and Screen Updates
Application.DisplayAlerts = False
Application.ScreenUpdating = False
' Open Current Year - Month Folder find the last file in the folder and open it (if Error GoTo error label)
oPath = "X:\Resource_Management\Historical_Files\Pre_Consolidated_Fund_Status_Workbooks\" & "FY" & _
    Year(Date) & "\" & MonthName(Month(Date), False)
    If Right(oPath, 1) <> "\" Then oPath = oPath & "\"
    MyFile = Dir(oPath & "*.xlsx", vbNormal)
    If Len(MyFile) = 0 Then
        GoTo GetPreviousFile:
    End If
    Do While Len(MyFile) > 0
        LMD = FileDateTime(oPath & MyFile)
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
MyFile = Dir
Loop
Workbooks.Open oPath & LatestFile
GoTo CreateFolder:

CreateFolder:
Application.DisplayAlerts = False
Application.ScreenUpdating = False
' Check for year folder and create if needed
If Len(Dir("X:\Resource_Management\Historical_Files\Pre_Consolidated_Fund_Status_Workbooks\" & "FY" & _
    Year(Date), vbDirectory)) = 0 Then
    MkDir "X:\Resource_Management\Historical_Files\Pre_Consolidated_Fund_Status_Workbooks\" & "FY" & Year(Date)
End If
' Check for month folder and create if needed
If Len(Dir("X:\Resource_Management\Historical_Files\Pre_Consolidated_Fund_Status_Workbooks\" & "FY" & _
    Year(Date) & "\" & MonthName(Month(Date), False), vbDirectory)) = 0 Then
    MkDir "X:\Resource_Management\Historical_Files\Pre_Consolidated_Fund_Status_Workbooks\" & "FY" & _
    Year(Date) & "\" & MonthName(Month(Date), False)
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
GoTo SaveFile:
End If

SaveFile:
' Save File
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ActiveWorkbook.SaveAs Filename:= _
        "X:\Resource_Management\Historical_Files\Pre_Consolidated_Fund_Status_Workbooks\" & "FY" & _
        Year(Date) & "\" & MonthName(Month(Date), False) & "\" & _
        "Consolidated_Fund_Status-CURRENT_DATA-" & Format(Application.WorkDay(Date, 0), "mm.dd.yyyy") & _
        ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ' Save any changes on exit, Turn on Screen Updates and Alerts
    ActiveWorkbook.Close SaveChanges:=True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub

' Open file from last months folder and the last file in that folder (on Error Resume Next)
GetPreviousFile:
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    On Error Resume Next
    MyPath = "X:\Resource_Management\Historical_Files\Pre_Consolidated_Fund_Status_Workbooks\" & _
        "FY" &Year(Date) & "\" & MonthName(Month(Date - 1), False)
        If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        MyFile = Dir(MyPath & "*.xlsx", vbNormal)
        If Len(MyFile) = 0 Then
            'MsgBox "No Files were found...", vbExclamation
        End If
        Do While Len(MyFile) > 0
            LMD = FileDateTime(MyPath & MyFile)
            If LMD > LatestDate Then
                LatestFile = MyFile
                LatestDate = LMD
            End If
        MyFile = Dir
        Loop
        Workbooks.Open MyPath & LatestFile
        GoTo CreateFolder:
' Turn back on Display Alerts and Screen Updates
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 1

Через некоторое время мне нужно было найти лучший способ получить конечные результаты, и это то, что я придумал. Я работал над созданием FUNCTION для расчета рабочих дней месяца. Мой код выглядит примерно так:

Function WorkdayOfMonth(ByVal dtInput As Date) As Integer
    Dim dt As Date
    Dim i As Integer
    If Weekday(dtInput, vbMonday) < 6 Then
        For dt = DateSerial(Year(dtInput), Month(dtInput), 1) To dtInput Step 1
            If Weekday(dt, vbMonday) < 6 Then i = i + 1
        Next dt
        WorkdayOfMonth = i
    Else
        WorkdayOfMonth = 0
    End If
End Function

Я поместил эту ФУНКЦИЮ в конец своего сабвуфера, и для своего сабвуфера я изменил свой код, чтобы он выглядел примерно так:

Dim oPath, FPath, MyPath, MyFile, LatestFile, FiscalYR, CFYMnth, PRFYMnth, PRFYear As String
Dim Lastrow, lCopyLastRow, lDestLastRow As Long
Dim LatestDate, LMD As Date
Dim wsCopy, wsDest As Worksheet

If MonthName(Month(Date), False) = "October" Then
    FiscalYR = Year(Date) + 1
    ElseIf MonthName(Month(Date), False) = "November" Then
        FiscalYR = Year(Date) + 1
        ElseIf MonthName(Month(Date), False) = "December" Then
            FiscalYR = Year(Date) + 1
    Else
        FiscalYR = Year(Date)
End If

PRFYear = FiscalYR - 1
CFYMnth = MonthName(Month(Date), False)
PRFYMnth = MonthName(Month(Date) - 1, False)

    ' Turn off Display Alerts and Screen Updates
Application.DisplayAlerts = False
Application.ScreenUpdating = False

    ' Open Month Folder find the last file in the folder and open it ()
If CFYMnth = "October" Then
    If WorkdayOfMonth(Date) > 0 And WorkdayOfMonth(Date) <= 3 Then
    End If
    MyPath = "X:\Resource_Management\Historical_Files\Final_Consolidated_Fund_Status_Workbooks\" & _
        PRFYear & "\" & PRFYMnth
        If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        MyFile = Dir(MyPath & "*.xlsx", vbNormal)
        If Len(MyFile) = 0 Then
            'MsgBox "No Files were found...", vbExclamation
        End If
        Do While Len(MyFile) > 0
            LMD = FileDateTime(MyPath & MyFile)
            If LMD > LatestDate Then
                LatestFile = MyFile
                LatestDate = LMD
            End If
        MyFile = Dir
        Loop
        Workbooks.Open MyPath & LatestFile
    GoTo FinalConsolFSWSaveAsProcess
Else
    If Len(Dir("X:\Resource_Management\Historical_Files\Final_Consolidated_Fund_Status_Workbooks\" & _
        FiscalYR & "\" & CFYMnth)) = 0 Then
        oPath = "X:\Resource_Management\Historical_Files\Final_Consolidated_Fund_Status_Workbooks\" & _
                FiscalYR & "\" & PRFYMnth
                If Right(oPath, 1) <> "\" Then oPath = oPath & "\"
                MyFile = Dir(oPath & "*.xlsx", vbNormal)
                If Len(MyFile) = 0 Then
                        'MsgBox "No Files were found...", vbExclamation
                End If
            Do While Len(MyFile) > 0
                    LMD = FileDateTime(oPath & MyFile)
                    If LMD > LatestDate Then
                    LatestFile = MyFile
                    LatestDate = LMD
                    End If
            MyFile = Dir
            Loop
            Workbooks.Open oPath & LatestFile
        GoTo FinalConsolFSWSaveAsProcess
    Else
        oPath = "X:\Resource_Management\Historical_Files\Final_Consolidated_Fund_Status_Workbooks\" & _
            FiscalYR & "\" & CFYMnth
            If Right(oPath, 1) <> "\" Then oPath = oPath & "\"
            MyFile = Dir(oPath & "*.xlsx", vbNormal)
            If Len(MyFile) = 0 Then
                'MsgBox "No Files were found...", vbExclamation
            End If
            Do While Len(MyFile) > 0
                LMD = FileDateTime(oPath & MyFile)
                If LMD > LatestDate Then
                    LatestFile = MyFile
                    LatestDate = LMD
                End If
        MyFile = Dir
        Loop
        Workbooks.Open oPath & LatestFile
    GoTo FinalConsolFSWSaveAsProcess
End If
End If

FinalConsolFSWSaveAsProcess:
    ' Save File in current month and FY location
ActiveWorkbook.SaveAs Filename:= _
"X:\Resource_Management\Historical_Files\Final_Consolidated_Fund_Status_Workbooks\" & _
    FiscalYR & "\" & CFYMnth & "\" & _
    "FY" & FiscalYR & " Consolidated_Fund_Status_Workbook-" & _
    Format(Application.WorkDay(Date, 0), "mm.dd.yyyy") & _
    ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ' Save any changes on exit, Turn on Screen Updates and Alerts
ActiveWorkbook.Save
ActiveWorkbook.Close SaveChanges:=True
    ' Turn back on Display Alerts and Screen Updates
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Это прекрасно работает для того, что мне нужно сделать. Я надеюсь, что это помогает другим.

Answer 2

На это ответил PeterT

Да, вы можете использовать его там или в любом месте, в котором вам нужна дата предыдущего месяца. Кроме того, вы можете создать переменную с этой строкой даты, а затем просто использовать это:

Dim lastMonth As String; lastMonth = Year(DateAdd("m", -1, Date)) & "\" & MonthName(Month(DateAdd("m", -1, Date))), then MyPath = "X:\Resource_Management\Historical_Files\Pre_Consolidated_Fund_Status_Workbooks\" & "FY" & lastMonth

- PeterT