VBA返回错误的月份日期字

时间:2018-02-28 02:25:35

标签: vba ms-word filenames

由于某些原因我在创建文件时出现了以下代码的问题,它只在正确月份的30日而不是31日,而在2月创建到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 currentMonth

End Sub

Function 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:=wdFormatXMLDocument

End Sub

有什么想法吗?

1 个答案:

答案 0 :(得分:1)

在这一行:

SQL>     SELECT *
  2      FROM   (SELECT player, game, phone, count( distinct phone) over ( partition by player ) as no_phones
  3              FROM   t2)
  4      PIVOT  (count(phone) AS cnt FOR (game) IN ('1a','1b','2a','2b','3a','3c'));

PLAYER      NO_PHONES   '1a'_CNT   '1b'_CNT   '2a'_CNT   '2b'_CNT   '3a'_CNT   '3c'_CNT
---------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
ccc                 1          0          0          0          1          0          0
ddd                 2          1          0          0          0          0          0
aaa                 3          2          1          0          0          0          0
bbb                 2          0          0          1          1          0          0

currentDay很长,而您尝试将其用作字符串。我将其编码如下:

ActiveDocument.SaveAs2 FileName:=folderName & Application.PathSeparator & monthsArray(currentMonth) & " " & currentDay, FileFormat:=wdFormatXMLDocument

另外,我会重写这一行:

Dim documentName as string
documentName = monthsArray(currentMonth) & " " & CStr(currentDay)
ActiveDocument.SaveAs2 FileName:=folderName & Application.PathSeparator & documentName, FileFormat:=wdFormatXMLDocument

为:

endOfMonth = CLng(Format$(dhLastDayInMonth(DateSerial(myYear, currentMonth + 1, 0)), "dd"))