Forum member Charles Kenyon has written a macro that backs up the normal.dotm template. See below.
Could someone revise it so it asks where to place the backup and saves it there, appending the date as it does now?
Thank you and have a good day!
Susan Flamingo
------------------------------------------------>
Sub BackUpNormalTemplate()
' Run to Backup Normal template to dated backup
' Charles Kenyon 10 Jan 2020
'
Backup Normal Template Macro
' Appends date to "Normal Backup" when saving, saves in special folder,
' then returns save path to current - thanks to Jay Freedman for that
' This code must be in the Normal template to work - not in another global
'
On Error Resume Next
Dim strName As String
Dim intLenPath As Integer ' length of path to templates folder without name of folder
Dim strPath As String 'Holder for current path
Dim strStorePath As String
'
Let intLenPath = InStrRev(Application.Options.DefaultFilePath(wdUse rTemplatesPath), "")
Let strStorePath = Left(Application.Options.DefaultFilePath(wdUserTem platesPath), intLenPath)
Let strStorePath = strStorePath & "Normal Backups"
'
' Check if folder exists, if not, create it
If Dir(strStorePath) = vbNullString Then MkDir (strStorePath)
'
Let strPath = Application.Options.DefaultFilePath(wdDocumentsPat h)
Let strName = "Normal Backup"
' add date & Time
Let strName = strName & " " & Format((Year(Now() + 1) Mod 100), "20##") & "-" & _
Format((Month(Now() + 1) Mod 100), "0#") & "-" & _
Format((Day(Now()) Mod 100), "0#") & "-" & _
Format(Now(), "HH_mm") 'add date & time
'
' Do the save
' MsgBox strStorePath & strName & ".dotm"
ThisDocument.Save 'save normal template (code holder) itself
ThisDocument.SaveAs2 FileName:=strStorePath & "" & strName & ".dotm", Addtorecentfiles:=False
' Reset save path
Let Application.Options.DefaultFilePath(wdDocumentsPat h) = strPath
'
' reset error message
MsgBox "The Normal.dotm template was saved as " & strName & ".dotm" & vbCr & vbLf & " in the folder: " & strStorePath, Title:="Completed", Buttons:=vbOKOnly
'
On Error GoTo -1
End Sub
<------------------------------------------------------------------------