Naming worksheet as part of file name

[kaffal]

Hi all, I have a macro to loop through the files in a folder. The macro will then open up the files and copy over to a new workbook.

As I want to rename the worksheets created in the new workbook as part of the file name. Any idea how to extract the file name out and stored in a string?

Currently it will be named after the Cell A1 in the opened file. However I would like to rename as below.

Example, the file name : 030309_Mary Sales.xls, Worksheet Name to Create : Mary Sales.
File name : 030309_John King, Worksheet Name : John King


(in the code, 030309 taken from my menu sheet,D4 is the keyword , to search in files containing D4, where D3 is the directory to look in)

Sub RunCodeOnAllXLSFiles()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

fpath = Sheets("menu").Range("D3")
fcriteria = Sheets("menu").Range("D4")

i = 2
    With Application.FileSearch
        .NewSearch
         'Change path to suit
        .LookIn = fpath
        .FileType = msoFileTypeExcelWorkbooks
        .FileName = fcriteria & "*.xls"
    

            If .Execute > 0 Then 'Workbooks in folder

              For lCount = 1 To .FoundFiles.Count 'Loop through all.
                 'Open Workbook x and Set a Workbook variable to it
                 Set wbResults = Workbooks.Open(FileName:=.FoundFiles(lCount), UpdateLinks:=0)


                 'DO YOUR CODE HERE
                  TabName = Range("A1").Value
                  EmptyCell = Range("C4").Value
                  If EmptyCell <> "" Then
                     ActiveSheet.Name = TabName
                                  
                     Sheets(TabName).Copy After:=wbCodeBook.Sheets(1)
                                        
                     ActiveSheet.Columns("B:AZ").AutoFit
                     
                     i = i + 1
                                                        
                     wbCodeBook.Sheets("Menu").Cells(i, 2).Value = "Completed"
                     wbCodeBook.Sheets("Menu").Cells(i + 18, 4).Value = TabName
                  
                  
                  End If
                  wbResults.Close savechanges:=False
                  
                  
                 Next lCount
                 
            End If
            
            Sheets("Menu").Select

    End With

    On Error GoTo 0
                               
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
 
End Sub

 

[PA HS Teacher]

Did you want something like this?

<font face=Courier New><SPAN style="color:#00007F">Dim</SPAN> s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>s = Mid(WbResults.Name, InStr(WbResults.Name, "_") + 1)<br>TabName = Left(s, Len(s) - 4)</FONT>

 

[kaffal]

Hi it works!
But what happen if the file name is something like 030309_Mary Sales_today.xls, 030309_John King.xls

I only want Mary Sales, and John King to be captured.

Sorry I did not clarify my condition earlier on.

 

[Legacy 68668]

try

Dim x As String
x = Mid(wbResults.Name, InStrRev(wbResults.Name, "_") + 1)

 

[PA HS Teacher]

<font face=Courier New><SPAN style="color:#00007F">Dim</SPAN> s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>s = Mid(WbResults.Name, InStr(WbResults.Name, "_") + 1)<br><SPAN style="color:#00007F">If</SPAN> InStr(1, s, "_") = 0 <SPAN style="color:#00007F">Then</SPAN><br>   TabName = Left(s, Len(s) - 4)<br><SPAN style="color:#00007F">Else</SPAN><br>   TabName = Left(s, InStr(1, s, "_") - 1)<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN></FONT>

 

[Legacy 68668]

Dim x As String
x = Replace(Mid(wbResults.Name, InStrRev("_" & wbResults.Name, "_") + 1),"xls","")

 

[kaffal]

try

Dim x As String
x = Mid(wbResults.Name, InStrRev(wbResults.Name, "_") + 1)

it captured the last word as the file name after "_".
For example, it captured today for file name 030309_Mary Sales_today.xls
while I wan to captured Mary Sales instead of today.

Maybe I can define x = string after the first"_" and end before the next "_" or "."
Any idea how to code this condition ?

 

[PA HS Teacher]

"Maybe I can define x = string after the first"_" and end before the next "_" or "."
Any idea how to code this condition ? "

See my previous post.

 

[Legacy 68668]

what happen if the file name is something like 030309_Mary Sales_today.xls, 030309_John King.xls

I only want Mary Sales, and John King to be captured.

What other possible conditions do you have ?

 

[Legacy 68668]

Does this good enough or do you have other pattern ?

Dim x As String
x = Replace(Replace(wbResults.Name,"_today.xls",""),".xls","")
x = Mid(wbResults.Name, InStrRev("_" & wbResults.Name, "_") + 1)