我想在 Word 中创建一个 VBA 代码，该代码将创建多个具有不同文件名的 word 文件

Question

我想使用 Visual Basic 创建同一个 Word 文件的多个保存。每个文件都需要用月份的日期和月份名称（不是数字）命名我希望它在每个月从 1 到 31 运行。我有一个粗略的代码，

Sub Mine()
 Dim DateStr, FileStr As String
  DateStr = Format$(Date, "DD")
  FileStr = DateStr & ".docx"

  ActiveDocument.Save
  ChangeFileOpenDirectory "Z:\FIR MASTER FOLDER\FCR briefing sheet\2018\Test"
  ActiveDocument.SaveAs2 FileName:=FileStr, FileFormat:=wdFormatXMLDocument

End Sub

现在我如何添加循环和日期和月份格式部分

Answer 1

试试下面的。如果您想要在评论中提到的格式，只需输入

Debug.Print monthName & " " & i

在对原始问题的修正中保存到不同的文件夹。我很高兴更新，但这应该可以解决您提出的最初问题。

它适用于当前月份。您需要进行测试以确保不存在。我试图向您展示您可能会考虑的每个功能以及如何构建循环。

将此处的函数用于end of month。

Sub test()

Dim myDate As Date
Dim myMonth As Long

myDate = Date

Dim monthName As String
monthName = Format$(myDate, "mmmm")

Dim endOfMonth As Long
endOfMonth = CLng(Format$(dhLastDayInMonth(myDate), "dd"))

Dim i As Long

For i = 1 To endOfMonth
     Debug.Print monthName & " " & i
Next i


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

所以用文件名保存你会做这样的事情：

For i = 1 To endOfMonth
     ActiveDocument.SaveAs fileName:= "C:\Test\" & monthName & " " & i, FileFormat:=wdFormatXMLDocument
Next i

参考：

http://www.java2s.com/Code/VBA-Excel-Access-Word/Word/TosaveadocumentwithanewnameusetheSaveAsmethod.htm

或为当年创建文件夹：

Sub AddFoldersAndFiles()

    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:\Users\User\Desktop\" ' path to create folders at

    myYear = Year(Date)

    Dim monthsArray() As Variant

    monthsArray = Array("January","February","March","April","May","June","July","August","September","October","November","December")

   Dim currentMonth As Long

   For currentMonth = LBound(monthsArray) To UBound(monthsArray)

       Dim folderName As String

       folderName = filePathStub & 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