1

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

Cindy Meister
  • 25,071
  • 21
  • 34
  • 43
  • can you show an example output name so we know what format? Also, is this intended to create for every day of the current month? What happens if the file already exists? – QHarr Feb 24 '18 at 14:53
  • Hi i want it to ouput a file name "1 march" "2 march" "1 april" "2 april, the files are put into a seperate folder by year so exsisting files will not be affected. i want it to create it say 31 for jan, then 28/29 for feb then 31 for march and so on. – Nick Freeman Feb 24 '18 at 15:04

1 Answers1

0

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
QHarr
  • 83,427
  • 12
  • 54
  • 101
  • endOfMonth = CLng(Format$(Application.WorksheetFunction.EoMonth(myDate, 0), "dd")) this is not working, also where do i put the file extension? – Nick Freeman Feb 24 '18 at 15:12
  • Are you familiar with the immediate window? Ctrl & G to open. That is where Debug.Print is writing the file names to at present. – QHarr Feb 24 '18 at 15:14
  • ok it doesn't like the worksheet function text and where do i put the bit about activedocument save? – Nick Freeman Feb 24 '18 at 15:14
  • hi thats working in the immediate screen. now where do i put the code to make it save the files to a specific folder with these file names – Nick Freeman Feb 24 '18 at 15:28
  • you would add the folder path and seperator before the monthName bit – QHarr Feb 24 '18 at 15:30
  • one final question where do i put the moth part for the month i want to create, currently it is creating for all of february which i great, but how do where do i alter in the program to get it to do march then april and so on? – Nick Freeman Feb 24 '18 at 15:40
  • do you want it to create for 1 year in total, all month? – QHarr Feb 24 '18 at 15:41
  • i want to get it to do all of march into the march folder then change the file extension (which i can do) then do all of april, then in a new folder may and so on for the whole of 2018 – Nick Freeman Feb 24 '18 at 15:42
  • At present I am getting the month using today's date in the line myDate = Date . Were you to say myDate = "2018-03-01" then it should run for March etc. – QHarr Feb 24 '18 at 15:42
  • Might be good to post as new question if you want the folder bit done as well. Essentially, you want to loop the 12 months, first generating a folder with the month name, then attaching that folder name to the path for saving the months files to (the inner loop) then loop for next month. You can use FileSystemObject to create the folders. – QHarr Feb 24 '18 at 15:46
  • ok thats fine i can manually change the folder as they are already created. th date par is not working correctly as it is creating them for june if i put mydate = 01-03-2018 or july with 2018-03-01 – Nick Freeman Feb 24 '18 at 15:59
  • What happens if you put myDate = #3/1/2018# – QHarr Feb 24 '18 at 16:03
  • excellent just tried that it is now doing everything i wanted. thank you so much for all your help :) – Nick Freeman Feb 24 '18 at 16:09
  • Updated with folder code. In case you wanted it. I haven't checked for typos so let me know. I typed whole thing in, not copy pasted. You will need the function from the first version to use with the second version. – QHarr Feb 24 '18 at 16:34
  • hi tried to use the folder code but it does not like folderName = fso.CreateFolder FolderName i have pasted the function from the previous one at the end – Nick Freeman Feb 27 '18 at 23:32
  • I found and fixed the error it should be folderName = fso.CreateFolder(folderName) thanks for all your help though – Nick Freeman Feb 27 '18 at 23:38
  • Oh sorry! Not sure how I forgot to that. Guess was typing in manually! So sorry!!!! – QHarr Feb 28 '18 at 03:31