I found this code on www.TheSpreadsheetGuru.com. The code opens every workbook in a folder and performs a task then closes each of them. It loops through the entire folder and does this. I am trying to have this insert some formulas and then save it as a .xlsx, the name would be the value found in cell I2. Right now the macro inserts the formulas fine but errors out when it try's to save as. Can anyone tell me what I'm missing here? I inserted the save as portion by itself and then the entire macro below.
This is the portion that I am using to do the save as.
Here is the entire macro.
This is the portion that I am using to do the save as.
Code:
<code>
'********This is the snippet that won't work.*************************
'Below saves the workbook based on what is in cell I2
Application.DisplayAlerts = False
Path = "C:\Users\RPlohocky\Desktop\Emailed Temp Files\Lisa Anderson\New Project\Test Folder" 'Change the directory path here where you want to save the file
FileName = Range("I2").Value & ".xlsx" 'Change extension here
ActiveWorkbook.SaveAs Path & FileName, FileFormat:=xlOpenXMLWorkbook 'Change the format here which matches with the extention above. Choose from the following link [URL]http://msdn.microsoft.com/en-us/library/office/ff198017.aspx[/URL]
Application.DisplayAlerts = True
'***************************************************************************
</code>
Here is the entire macro.
Code:
<code>
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: [URL="http://www.TheSpreadsheetGuru.com"]www.TheSpreadsheetGuru.com[/URL]
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim FileName As String
Dim Path As String
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "C:\Users\RPlohocky\Desktop\Emailed Temp Files\Lisa Anderson\New Project\Test Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & ""
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.csv*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(FileName:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Change First Worksheet's Background Fill Blue
'wb.Worksheets(1).Range("A1").Interior.Color = RGB(51, 98, 174)
'Below will creates the name for this workbook in cell BC2.
wb.Worksheets(1).Range("BA2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-47],8)"
wb.Worksheets(1).Range("BB2").Select
ActiveCell.FormulaR1C1 = _
"=LEFT(RC[-51],4)&""-""&MID(RC[-51],5,2)&""-""&RIGHT(RC[-51],2)&""-"""
wb.Worksheets(1).Range("BC2").Select
ActiveCell.FormulaR1C1 = "=CONCAT(RC[-2],RC[-1],RC[-51])"
Range("BC2").Select
'********This is the snippet that won't work.*************************
'Below saves the workbook based on what is in cell I2
Application.DisplayAlerts = False
Path = "C:\Users\RPlohocky\Desktop\Emailed Temp Files\Lisa Anderson\New Project\Test Folder" 'Change the directory path here where you want to save the file
FileName = Range("I2").Value & ".xlsx" 'Change extension here
ActiveWorkbook.SaveAs Path & FileName, FileFormat:=xlOpenXMLWorkbook 'Change the format here which matches with the extention above. Choose from the following link [URL]http://msdn.microsoft.com/en-us/library/office/ff198017.aspx[/URL]
Application.DisplayAlerts = True
'***************************************************************************
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
</code>
Last edited by a moderator: