VBA Code for Searching\Renaming files in a folder

[Yonk1]

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]

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]

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