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

问题描述:

我想使用Visual Basic创建同一Word文件的多个保存.每个文件都需要用月份中的月份和月份名称(而不是数字)来命名,我希望它在每个月的1到31之间运行.我有一个粗略的代码,

I want to create multiple saves of the same word file using visual basic. each file will need to be named with the day of the month and month name (not numbers) i want this to run from the 1 to 31 on each month. i have a rough code,

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

现在如何添加循环以及日和月格式部分

now how do i add the loop and the day and month format part

请尝试以下操作.如果您希望使用注释中提到的格式,则只需输入

try the below. If you want in the format you mention in comment simply put as

Debug.Print monthName & " " & i

在对原始问题的修正中保存到其他文件夹.我很高兴进行更新,但这应该可以解决您提出的第一个问题.

Saving to different folders in an amendment to your original question. I am happy to update but this should deal with your initial question as posed.

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

It works with the current month. You would want a test to make sure doesn't already exist. I tried to show you each of the functions you might consider and how you could structure a loop.

在此处使用结尾的功能月.

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

因此,使用文件名保存您将执行以下操作:

So save with the filename you would do something like:

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/使用SaveAsmethod.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