Yonk1
09-14-2016, 05:17 AM
Afternoon All, I'm a complete novice in coding but have been given the task to find/create a macro. The macro needs to search through a specified folder for certain CSV files and then rename these files based on the value in cell A1, for each individual workbook.
I have been pouring through many different forums trying to match up and resolve different pieces of code, but I've restarted so many times now that I feel I'm just going in circles. This is my latest attempt... Please try not to laugh :P.
Sub Test1()
Dim fileName As String, Path As String, File As String
File = Dir(directory & "exp*.csv")
Path = "C:\Users\User\Desktop\Test\"
fileName = Range("A1").Value & ".csv" 'Change extension here
Application.DisplayAlerts = False
Do While fileName <> ""
Workbooks.Open (Path & File)
ActiveWorkbook.SaveAs Path & fileName, xlCSV
If ThisWorkbook.Saved = False Then
ThisWorkbook.Save
End If
ActiveWorkbook.Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
End Sub
As it is, it will open a file in the specified folder and rename it according to the value in A1 of that workbook, but that's where it ends.
Below is a previous attempt which is a lot messier. This one allows you to select a directory (id prefer it looked in a specified directory, rather than asking the user) and then attempts to rename the files, however it doesnt seem to recognize any CSV's in the specified folder.
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
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
Path = "C:\Users\User\Desktop\Test\"
fileName = Range("A1").Value & ".csv" 'Change extension here
directory = "C:\Users\User\Desktop\Test\"
myFile = Dir(directory & "*.csv")
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wb = myFile
NextCode:
myPath = "C:\Users\User\Desktop\Test\"
If myPath = "" Then GoTo ResetSettings
myExtension = "*.csv"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(fileName:=myPath & myFile)
DoEvents
ActiveWorkbook.SaveAs myPath & fileName, xlCSV
If ThisWorkbook.Saved = False Then
ThisWorkbook.Save
End If
Application.DisplayAlerts = False
ActiveWorkbook.Close
DoEvents
myFile = Dir(myPath & myExtension)
Loop
MsgBox "Task Complete!"
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Apologies for this appauling peice of coding :P
Please let me know if I've missed out any key info and ill do my best to respond asap.
Thank you in advance for any tips/advice.
Many Thanks,
I have been pouring through many different forums trying to match up and resolve different pieces of code, but I've restarted so many times now that I feel I'm just going in circles. This is my latest attempt... Please try not to laugh :P.
Sub Test1()
Dim fileName As String, Path As String, File As String
File = Dir(directory & "exp*.csv")
Path = "C:\Users\User\Desktop\Test\"
fileName = Range("A1").Value & ".csv" 'Change extension here
Application.DisplayAlerts = False
Do While fileName <> ""
Workbooks.Open (Path & File)
ActiveWorkbook.SaveAs Path & fileName, xlCSV
If ThisWorkbook.Saved = False Then
ThisWorkbook.Save
End If
ActiveWorkbook.Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
End Sub
As it is, it will open a file in the specified folder and rename it according to the value in A1 of that workbook, but that's where it ends.
Below is a previous attempt which is a lot messier. This one allows you to select a directory (id prefer it looked in a specified directory, rather than asking the user) and then attempts to rename the files, however it doesnt seem to recognize any CSV's in the specified folder.
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
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
Path = "C:\Users\User\Desktop\Test\"
fileName = Range("A1").Value & ".csv" 'Change extension here
directory = "C:\Users\User\Desktop\Test\"
myFile = Dir(directory & "*.csv")
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wb = myFile
NextCode:
myPath = "C:\Users\User\Desktop\Test\"
If myPath = "" Then GoTo ResetSettings
myExtension = "*.csv"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(fileName:=myPath & myFile)
DoEvents
ActiveWorkbook.SaveAs myPath & fileName, xlCSV
If ThisWorkbook.Saved = False Then
ThisWorkbook.Save
End If
Application.DisplayAlerts = False
ActiveWorkbook.Close
DoEvents
myFile = Dir(myPath & myExtension)
Loop
MsgBox "Task Complete!"
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Apologies for this appauling peice of coding :P
Please let me know if I've missed out any key info and ill do my best to respond asap.
Thank you in advance for any tips/advice.
Many Thanks,