我想在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