VBA возвращает неверный месяц

Nick Freeman спросил: 03 февраля 2018 в 12:45 в: vba

У меня есть проблема со следующим кодом, по какой-то причине при создании файлов он работает только 30-е, а не 31-е в правильные месяцы, а в феврале он создает до 30-го. Код предназначен для создания папки для каждого месяца, а затем создания месячных файлов из 1 основного документа. Исходный код, который я использовал, работал, но не создавал папки.

Это код, возвращающий ошибку.

 Sub Folder()    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")    'Dim fso As FileSystemObject     ' ''early binding. Requires reference to MS Scripting runtime
    'Set fso = New FileSystemObject     ''early binding    Dim myYear As Long
    Dim endOfMonth As Long
    Dim filePathStub As String    filePathStub = "c:\user\test briefing sheet\2019\" ' path to create folders at"    myYear = 19    Dim monthsArray() As Variant    monthsArray = Array("Jan", "Feb", "Mar", "April", "May", "Jun", "Jul", "Aug", "Sept", "Oct", "Nov", "Dec")   Dim currentMonth As Long   For currentMonth = LBound(monthsArray) To UBound(monthsArray)       Dim folderName As String       folderName = monthsArray(currentMonth) & " " & CStr(myYear)       folderName = fso.CreateFolder(folderName)       endOfMonth = CLng(Format$(dhLastDayInMonth(DateSerial(myYear, currentMonth + 1, 0)), "dd"))       Dim currentDay As Long       For currentDay = 1 To endOfMonth           ActiveDocument.SaveAs2 FileName:=folderName & Application.PathSeparator & monthsArray(currentMonth) & " " & currentDay, FileFormat:=wdFormatXMLDocument       Next currentDay   Next currentMonthEnd SubFunction dhLastDayInMonth(Optional dtmDate As Date = 0) As Date
    ' Return the last day in the specified month.
    If dtmDate = 0 Then
        ' Did the caller pass in a date? If not, use
        ' the current date.
        dtmDate = Date
    End If
    dhLastDayInMonth = DateSerial(Year(dtmDate), _
     Month(dtmDate) + 1, 0)End Function

Это был исходный код

    Sub Mine()
     Dim DateStr, FileStr As String
      DateStr = Format$(Date, "DD")
      FileStr = DateStr & ".docx"      ActiveDocument.Save
      ChangeFileOpenDirectory "c:\user\test briefing sheet\2019\"
      ActiveDocument.SaveAs2 FileName:=FileStr, FileFormat:=wdFormatXMLDocumentEnd Sub

Любые идеи?


0 ответов