PDA

View Full Version : VBA Code for Searching\Renaming files in a folder



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,

mana
09-14-2016, 07:16 AM
Option Explicit


Sub test()
Dim myPath As String
Dim myName As String
Dim myBook As Workbook


myPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\test\"

myName = Dir(myPath & "*.csv")

Do While myName <> ""
Set myBook = Workbooks.Open(Filename:=myPath & myName)
On Error Resume Next
myBook.SaveAs myPath & myBook.Sheets(1).Range("A1").Value, xlCSV
On Error GoTo 0
myBook.Close False
myName = Dir()
Loop


End Sub

Yonk1
09-14-2016, 08:05 AM
Option Explicit


Sub test()
Dim myPath As String
Dim myName As String
Dim myBook As Workbook


myPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\test\"

myName = Dir(myPath & "*.csv")

Do While myName <> ""
Set myBook = Workbooks.Open(Filename:=myPath & myName)
On Error Resume Next
myBook.SaveAs myPath & myBook.Sheets(1).Range("A1").Value, xlCSV
On Error GoTo 0
myBook.Close False
myName = Dir()
Loop


End Sub