i want to create a VBA code in Word that will create multiple word files with different file names

丶灬走出姿态 提交于 2019-12-24 10:39:49

问题


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


回答1:


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.

Uses a function from here for 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

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

Reference:

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

Or to create folders for the year:

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


来源:https://stackoverflow.com/questions/48964106/i-want-to-create-a-vba-code-in-word-that-will-create-multiple-word-files-with-di

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!