File save as

[DanielS]

In the following folder "C:\General\Month" there are 30 to 31 subfolders and each subfolder has 7 csv files and 4 xls files (excel 2000). I want to perform the following actions on these files.
1. Find "Va*.csv" and save it as "Va*.xls" in the same path by converting to xls format.
2. Find "Ru*.xls" and save it as "Mes*.xls" in the same path but without renaming the original file. Rt should be replaced by Mts and rest of the characters in the file name should remain same. That means, file name will remain same.
3. Find "Per*.xls" and rename the same as "Data.xls" in the same path. Which means there will one Data.xls in each of the 30-31 subfolders. There will be only one Per*.xls in every subfolder, so no chance of 2 or more files to be renamed as Data.xls.
I would appreciate if someone could help me in this matter.

 

[GTO]

Are 1 and 2 SaveAs'ing ea file that validates name-wise (so we have two of ea) and #3 is renaming?

Also, could you provide some example names of each (in a column or table) so we can recreate easier?

 

[DanielS]

Dear GTO

Here are the sample file names:
In 1 and 2, except for first 2 and 3 characters, rest of the file name remains the same (In case of No. 1, after conversion to xls from csv) while in No. 3 the whole file name is changed. In 1 and 2, the original files will remain intact in the folder while in No.3, the original file will disappear and will be replaced by "Data.xls"

Directory path: C:\General\Month All files are located in the subfolders of "Month". I have provided the names of the files in one of the subfolders.

Sample file Names:
<TABLE style="WIDTH: 77pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=103 x:str><COLGROUP><COL style="WIDTH: 77pt; mso-width-source: userset; mso-width-alt: 3766" width=103><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 77pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17 width=103>Bc01AU11.csv</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>Ru01AU2011.csv</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>cf01AU2011.csv</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>Va01AU2011.csv</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>Rus01AU11.csv</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>ffix01AU11.csv</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>Gl01AU11.csv</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>An01AU11.xls</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>Per01AU11.xls</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>NPD01AU11.xls</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl22 height=17>nuver.xls


</TD></TR></TBODY></TABLE>

 

[GTO]

I want to perform the following actions on these files.
1. Find "Va*.csv" and save it as "Va*.xls" in the same path by converting to xls format.

Okay

2. Find "Ru*.xls" and save it as "Mes*.xls" in the same path but without renaming the original file. Rt should be replaced by Mts and rest of the characters in the file name should remain same. That means, file name will remain same.

Huh? I was hoping that your inclusion of example filenames would clear up the red part, but I don't see nothin' that matches "Ru*.xls".

3. Find "Per*.xls" and rename the same as "Data.xls" in the same path. Which means there will one Data.xls in each of the 30-31 subfolders. There will be only one Per*.xls in every subfolder, so no chance of 2 or more files to be renamed as Data.xls.

Okay.

Not thought through too far yet, but here's a start. Definitely test on some junk workbooks in a created folder!

Sub exa()
Dim FSO As Object ' FileSystemObject
Dim fsoParentFolder As Object ' Folder
Dim fsoFolder As Object ' Folder
Dim fsoFile As Object  ' File
Dim wb As Workbook
Dim StartPath As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    StartPath = ThisWorkbook.Path & "\" '<---Change to suit
    
    With FSO
        If .FolderExists(StartPath) Then
            Set fsoParentFolder = .GetFolder(StartPath)
            For Each fsoFolder In fsoParentFolder.SubFolders
                MsgBox fsoFolder.Path
                For Each fsoFile In fsoFolder.Files
                    If fsoFile.Name Like "Va*.csv" Then
                        Set wb = Workbooks.Open(fsoFile.Path)
                        If Not Convert2xls(wb, fsoFile.Name, fsoFolder.Path & "\") Then
                            MsgBox "Unable to convert " & fsoFile.Name & ".", vbCritical, vbNullString
                        End If
                    ElseIf fsoFile.Name Like "Per*.xls" Then
                        fsoFile.Name = "Data.xls"
                    End If
                Next
            Next
        Else
            MsgBox "Bad starting folder", vbInformation, vbNullString
            Exit Sub
        End If
    End With
End Sub
    
Function Convert2xls(wb As Workbook, ByVal FileName As String, ByVal Path As String) As Boolean
    
    On Error GoTo BailOut
    FileName = Left(FileName, InStrRev(FileName, ".") - 1) & ".xls"
    wb.SaveAs Path & FileName, xlNormal
BailOut:
    wb.Close False
    If Not Err Then Convert2xls = True
End Function

 

[DanielS]

Dear GTO

Yours is an excellent piece of code and it is working flawlessly. I have tested it on 5 subfolders to start with.

With regards to No.2, I am sorry, I made a series of blunders. Infact, I wanted "An*.xls" to be saved as "Mes*.xls". Could you incorporate this in the code?.

Thanks once again for your help.

 

[DanielS]

Dear GTO

Yours is an excellent piece of code and it is working flawlessly. I have tested it on 5 subfolders to start with.

With regards to No.2, I am sorry, I made a series of blunders. Infact, I wanted "An*.xls" ("An" followed by 6 characters as in the file list) to be saved as "Mes*.xls" ("Mes" followed by 6 original characters). Could you incorporate this in the code?.

Thanks once again for your help.

 

[GTO]

...Infact, I wanted "An*.xls" ("An" followed by 6 characters as in the file list) to be saved as "Mes*.xls" ("Mes" followed by 6 original characters)...

Hi Daniel,

From what you've stated so far, it sounds as if the files (names and such) are extremely consistent. That is, there's only one file named such and such, there's six characters past the 'An', and so on. Based on that, this would check for 'An', followed by exactly six characters (followed by '.xls').

Option Explicit
    
Sub exa()
Dim FSO             As Object '<--- FileSystemObject
Dim fsoParentFolder As Object '<--- Folder
Dim fsoFolder       As Object '<--- Folder
Dim fsoFile         As Object '<--- File
Dim wb              As Workbook
Dim StartPath       As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    StartPath = ThisWorkbook.Path & "\" '<---Change to suit
    
    With FSO
        If .FolderExists(StartPath) Then
            Set fsoParentFolder = .GetFolder(StartPath)
            For Each fsoFolder In fsoParentFolder.SubFolders
                For Each fsoFile In fsoFolder.Files
                    If fsoFile.Name Like "Va*.csv" Then
                        Set wb = Workbooks.Open(fsoFile.Path)
                        If Not Convert2xls(wb, fsoFile.Name, fsoFolder.Path & "\") Then
                            MsgBox "Unable to convert " & fsoFile.Name & ".", vbCritical, vbNullString
                        End If
                    ElseIf fsoFile.Name Like "Per*.xls" Then
                        fsoFile.Name = "Data.xls"
                    '//IF .Name is 'An' followed by six chars, then by '.xls' ...//
                    ElseIf fsoFile.Name Like "An??????.xls" Then
                        fsoFile.Name = "Mes" & Mid(fsoFile.Name, 3)
                    End If
                Next
            Next
        Else
            MsgBox "Bad starting folder", vbInformation, vbNullString
            Exit Sub
        End If
    End With
End Sub
    
Function Convert2xls(wb As Workbook, ByVal FileName As String, ByVal Path As String) As Boolean
    
    On Error GoTo BailOut
    FileName = Left(FileName, InStrRev(FileName, ".") - 1) & ".xls"
    wb.SaveAs Path & FileName, xlNormal
BailOut:
    wb.Close False
    If Not Err Then Convert2xls = True
End Function

I would note that we are not doing a SaveAs, rather, leaving the wb closed and renaming it. Does that help?

Mark