Need to make multiple copies of shift report with different dates in the name of the xlsx file.

[mwinter]

I am a lead maintenance mechanic and trying to figure out how to create dated shift reports. Our naming system is

(Master file is named "Shift Report.xlsx")
Shift Report 7-16-2021 D1
Shift Report 7-16-2021 N1
Shift Report 7-17-2021 D1
Shift Report 7-17-2021 N1
etc...

I have to generate these all the time some times I do a months worth other times I only do it daily because I have only been turning off auto-save and just clicking "save as" and changing the date maually. I know someone a lot smarter then me has already figured out how to accomplish this and I am hoping someone can save me hours of tedious file naming... I do use one template for all of them and just change the file name dates. All these are just saved into a sharepoint folder for each month at my work.

 

[John_w]

See if this code works for you. This code isn't an Excel VBA macro, but a VBScript script. Paste the code into Notepad and save it as "Create Copies.vbs". You then 'run' the script by dragging and dropping "Shift Report.xlsx" onto "Create Copies.vbs" in File Explorer.

Option Explicit

Dim title
Dim inputFile, inputFileName, p
Dim startDate, endDate, dt
Dim FSO

title = "Create multiple copies of Shift Report.xlsx"

If Wscript.Arguments.Count = 1 Then
    inputFile = WScript.Arguments(0)
    p = InstrRev(inputFile, "\")
    inputFileName = Mid(inputFile,p+1)
End If

If WScript.Arguments.Count = 0 Or inputFileName <> "Shift Report.xlsx" Then
    MsgBox "Error - Shift Report.xlsx must be dragged and dropped onto this script to create multiple copies.", vbCritical, title
    WScript.Quit(0)
End If

startDate = InputBox("Enter start date (mm/dd/yyyy)", title, Date)
If startDate = "" Then WScript.Quit(0)
endDate = InputBox("Enter end date (mm/dd/yyyy)", title, CDate(startDate)+1)
If endDate = "" Then WScript.Quit(0)

Set FSO = CreateObject("Scripting.FileSystemObject")

p = InstrRev(inputFile, ".")
For dt = CDate(startDate) To CDate(endDate)   
    FSO.CopyFile inputFile, Left(inputFile,p-1) & " " & Format_Date(dt) & " D1" & Mid(inputFile,p)
    FSO.CopyFile inputFile, Left(inputFile,p-1) & " " & Format_Date(dt) & " N1" & Mid(inputFile,p)
Next
    
WScript.Quit(0)

'Return string of specified date in m-d-yyyy format
Private Function Format_Date(d)
    Format_Date = Month(d) & "-" & Day(d) & "-" & Year(d)
End Function