Question

好的，我在下面的Tim代码中找到了它：）

编辑最终

用于更改带有文件夹名称的工作表名称：

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

使用部分文件夹名称重命名非活动工作表

2 个答案: