VBA 返回不正确的月份日期字词
VBA returning incorrect month dates word
出于某种原因,我在创建文件时遇到以下代码问题,它只在正确月份的 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 sheet19\" ' 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 sheet19\"
ActiveDocument.SaveAs2 FileName:=FileStr, FileFormat:=wdFormatXMLDocument
End Sub
有什么想法吗?
在这一行中:
ActiveDocument.SaveAs2 FileName:=folderName & Application.PathSeparator & monthsArray(currentMonth) & " " & currentDay, FileFormat:=wdFormatXMLDocument
currentDay 是 Long,而您正试图将其用作字符串。我将其编码如下:
Dim documentName as string
documentName = monthsArray(currentMonth) & " " & CStr(currentDay)
ActiveDocument.SaveAs2 FileName:=folderName & Application.PathSeparator & documentName, FileFormat:=wdFormatXMLDocument
另外,我 re-write 这行:
endOfMonth = CLng(Format$(dhLastDayInMonth(DateSerial(myYear, currentMonth + 1, 0)), "dd"))
如:
endOfMonth = DAY(dhLastDayInMonth(DateSerial(myYear, currentMonth + 1, 0)))
出于某种原因,我在创建文件时遇到以下代码问题,它只在正确月份的 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 sheet19\" ' 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 sheet19\"
ActiveDocument.SaveAs2 FileName:=FileStr, FileFormat:=wdFormatXMLDocument
End Sub
有什么想法吗?
在这一行中:
ActiveDocument.SaveAs2 FileName:=folderName & Application.PathSeparator & monthsArray(currentMonth) & " " & currentDay, FileFormat:=wdFormatXMLDocument
currentDay 是 Long,而您正试图将其用作字符串。我将其编码如下:
Dim documentName as string
documentName = monthsArray(currentMonth) & " " & CStr(currentDay)
ActiveDocument.SaveAs2 FileName:=folderName & Application.PathSeparator & documentName, FileFormat:=wdFormatXMLDocument
另外,我 re-write 这行:
endOfMonth = CLng(Format$(dhLastDayInMonth(DateSerial(myYear, currentMonth + 1, 0)), "dd"))
如:
endOfMonth = DAY(dhLastDayInMonth(DateSerial(myYear, currentMonth + 1, 0)))