重命名非有效表與文件夾名稱的一部分

Question

好吧，我想通了下面:)

編輯決賽

添碼與文件夾名稱改變工作表名稱：

Sub readFolder() 

On Error Resume Next 

Const sMainPath As String = "C:\ example" 'write directory here 
Dim sFile As String, sPathSeek As String, sPathMatch As String 
Dim i As Integer, sFolders As String, x As Integer, n As Integer 
i = 0 
x = 2 'start with sheet2, because sheet1 = panel for buttons 
sPathSeek = sMainPath 
n = ActiveWorkbook.Worksheets.Count 

sFile = Dir(sPathSeek, vbDirectory) 

    Do While Len(sFile) > 0 
    If Left(sFile, 1) <> "." Then 

     sName = "sheet" & x 
     If x > n Then 
      Sheets.Add After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet 
      ActiveSheet.Name = sName 
      Sheets(sName).Name = sFile 
     Else 
      Sheets(sName).Name = sFile 
     End If 

    x = x + 1 

    End If 
    sFile = Dir 
Loop 

End Sub 

---

感謝大家給我的想法來解決這個:)

Answer 1

以下是如何獲取文件夾名稱：

Dim folder_name as String 
Dim ws as Worksheet, location as Long 


folder_name = diafolder.SelectediItems(1) 
location = InStrRev("/", folder_name) 
folder_name = Mid(folder_name, location + 1, len(folder_name) - location) 

這樣的事情會讓你改變WS名稱。

Set ws = Thisworkbook.Sheets("Sheet1") 

With ws 
    .Name = folder_name 
End With 

希望這會有所幫助。

Answer 2

未經測試：

Sub readFolders() 

    Const sMainPath As String = "C:\Users\User\Desktop\excel\" 
    Dim sFile As String, sPathSeek As String, sPathMatch As String 
    Dim i As Integer, sFolders As String 

    i = 0 

    'On Error Resume Next 
    sPathSeek = sMainPath 

    sFile = Dir(sPathSeek, vbDirectory) 

    Do While Len(sFile) > 0 
     If Left(sFile, 1) <> "." Then 
      i = i + 1 
      If i <= 3 Then 
       ThisWorkbook.Sheets("Sheet" & i).Name = sFile 
       sFolders = sFolders & " '" & sFile & "'" 
      Else 
       Exit Do 
      End If 
     End If 
     sFile = Dir 
    Loop 

    MsgBox IIf(sFolders = "", "Match not found", "Match(es): " & sFolders) 

End Sub