Rename Multiple files. Help wanted

[jasper005]

Hello everyone. First off great site, with loads of useful information.

I?m trying to rename multiple files in one folder using VBA. All the file types I would like to rename are .asc and I would like to rename them as .csv with the same file name. I know how to do this with by specifying the original and the new file name...

Dim FileName As String
Dim NewFileName As String
On Error Resume Next
FileName = "C:\XXX.asc"
NewFileName = "c:\XXX.csv"
Name FileName As NewFileName

However as there are a large number of files to rename this isn?t very effective. Could somebody recommend a more effective way of doing this?

I found a great post by mdmackillop which I can use to identify all the .asc files however in the section where it allows you to do something with the files identified I'm not sure what code I should be using. The code from mdmackillop is below (slightly edited)...

Thanks for all your help in advanced.
Jasper

Sub OneType()
Const MyPath = "c:\XXXX" ' Set the path.
Const FileType = "*.asc" ' or "*.doc"
ProcessFiles MyPath, FileType
End Sub


Sub ProcessFiles(strFolder As String, strFilePattern As String)
Dim strFileName As String
Dim strFolders() As String
Dim iFolderCount As Integer
Dim i As Integer

'Collect child folders
strFileName = Dir$(strFolder & "\", vbDirectory)
Do Until strFileName = ""
If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
If Left$(strFileName, 1) <> "." Then
ReDim Preserve strFolders(iFolderCount)
strFolders(iFolderCount) = strFolder & "\" & strFileName
iFolderCount = iFolderCount + 1
End If
End If
strFileName = Dir$()
Loop

'process files in current folder
strFileName = Dir$(strFolder & "\" & strFilePattern)
Do Until strFileName = ""
'Do things with files here*****************
Debug.Print strFolder & "\" & strFileName

'*******************************************
strFileName = Dir$()
Loop

'Look through child folders
For i = 0 To iFolderCount - 1
ProcessFiles strFolders(i), strFilePattern
Next i
End Sub

[rory]

shell "cmd /c ren C:\XXXX\*.asc *.csv"

should do it.

[Bob Phillips]

Option Explicit

Private FSO As Object

Sub Folders()

Set FSO = CreateObject("Scripting.FileSystemObject")

SelectFiles "C:\Test\"

Set FSO = Nothing

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If Right$(oFile, 3) = "asc" Then
Name oFile As Left(oFile, Len(oFile) - 3) & "csv"
End If
Next oFile

For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next

End Sub

[jasper005]

XLD Im using your code and it works really well for what I asked for. However when i try to change a csv to an xls file it loses its formatting? For example instead of the data for Sep-07 being shown in column B C D E the data is shown as follows...

Sep-2007,0,1,13,398,412 (all in cell A)

Any ideas how i can prevent this?

Once again thank you both for your help.

Oh its worth pointing out that when you try it manually (ie right click rename and then change the file extension it also loses the formatting of the original CSV file) When i use the following VBA code that does not happen, however i have to specify each file name which is not very helpful.

I think the solution is that once all the files have been saved as .csv I need the code to load them and save them as an excel file (from within excel) as opposed to just renaming them. Could someone please add the required code to xlds code above, this would be greatly appreciated.

Thanks, Jasper

Sub Name()
'Rename as .csv
Dim FileName As String
Dim NewFileName As String
On Error Resume Next
'*************************************************************************
FileName = "C:\XXXXX\XXXXX.asc"
NewFileName = "C:\XXXXX\XXXXX.csv"
Name FileName As NewFileName
ChDir "C:\xxxx\"
Workbooks.Open FileName:= _
"C:\XXXXX\XXXXX.csv"
ActiveWorkbook.SaveAs FileName:= _
"C:\XXXXX\XXXXX.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.Close

[Bob Phillips]

Option Explicit

Private FSO As Object

Sub Folders()

Set FSO = CreateObject("Scripting.FileSystemObject")

SelectFiles "C:\Test\"

Set FSO = Nothing

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If Right$(oFile, 3) = "csv" Then
Workbooks.Open oFile.Path
With ActiveWorkbook
.SaveAs Left(oFile.Path, Len(oFile.Path) - 4), FileFormat:=xlNormal
.Close
End With
End If
Next oFile

For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next

End Sub

[jasper005]

Thanks thats perfect!

[daniel_d_n_r]

hmm I could have swore this post didn't have any replies until I made this.
I will post it anyways.

cheers

Option Explicit
Sub change_ext()
Dim path1 As String
Dim g As String
Dim filex, object2, object_fso, tempfolder

path1 = "C:\Documents and Settings\Dan\My Documents\Data_folder"
Set object_fso = CreateObject("Scripting.FileSystemObject")
Set tempfolder = object_fso.GetFolder(path1)
Set object2 = tempfolder.Files


For Each filex In object2
g = Left(Dir(filex, vbDirectory), InStr(Dir(filex, vbDirectory), "."))
filex.Name = CStr(g) + "csv"
Next


End Sub

'if run twice this will return a runtime error 58 'file already exists"
'you may have to add an error trap,like on error 58 display msgbox error message.