Excel macro help

[overst33r]

I need to make a macro that takes a folder of files and saves them as templates. Same file name.

This is what I have so far, based on some online research, but I haven't made any meaningful progress.

Sub AllFiles()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim folderPath As String
Dim filename As String
Dim wb As Workbook

folderPath = "Q:\Temp (Mario)\Archive" 'change to suit

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xls")
Do While filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)

ActiveWorkbook.SaveAs Filename:=Workbook, FileFormat:=xlTemplate, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[Tweak155]

I need to make a macro that takes a folder of files and saves them as templates. Same file name.

This is what I have so far, based on some online research, but I haven't made any meaningful progress.

Sub AllFiles()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim folderPath As String
Dim filename As String
Dim wb As Workbook

folderPath = "Q:\Temp (Mario)\Archive" 'change to suit

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xls")
Do While filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)

ActiveWorkbook.SaveAs Filename:=Workbook, FileFormat:=xlTemplate, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Does this actually do anything? It looks like it is missing at least one critical part.

First, change the + "\" to & "\", although the way it is written you don't need that line unless at some point down the road you will be passing in directories.

It looks like the only other thing you need to add is just before Loop.

Sub AllFiles()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim folderPath As String
Dim filename As String
Dim wb As Workbook

folderPath = "Q:\Temp (Mario)\Archive" 'change to suit

If Right(folderPath, 1) <> "\" Then folderPath = folderPath [b][u]&[/u][/b] "\"

filename = Dir(folderPath & "*.xls")
Do While filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)

ActiveWorkbook.SaveAs Filename:=Workbook, FileFormat:=xlTemplate, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

[b][u]filename = Dir$[/u][/b]
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Suggested changes in bold & underlined.

EDIT:

Reading through it again... You should be using wb.SaveAs and change Filename:=Workbook to where you want the file saved and with what name. Also close wb after. I suggest something like:

wb.SaveAs Filename:="Q:\Temp (Mario)\Archive\Templates\" & wb.Name, FileFormat:=xlTemplate, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

wb.Close

 

[overst33r]

Got it. Thank you very much!