VBA从路径获取文件名并将其存储到单元格

Question

我正在处理一些代码，我想找到所选文件的路径，提取文件名，然后将文件名写入工作表上的单元格。这是我到目前为止所做的：

Private Sub CommandButton3_Click()

Sheets("Raw Data").Unprotect

Application.DisplayAlerts = False
Sheets("Raw Data").Delete
Sheets.Add After:=Worksheets(1)
Worksheets(2).Name = "Raw Data"
Application.DisplayAlerts = True

Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim SourceRcount As Long
Dim n As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant

    SaveDriveDir = CurDir
    MyPath = "H:"
    ChDrive MyPath
    ChDir MyPath

    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
    If IsArray(FName) Then
        Application.ScreenUpdating = False
        Set basebook = ThisWorkbook
        For n = LBound(FName) To UBound(FName)
            Set mybook = Workbooks.Open(FName(n))
            Set sourceRange = mybook.Worksheets(1).Cells
            SourceRcount = sourceRange.Rows.Count
            Set destrange = basebook.Sheets("Raw Data").Cells
            sourceRange.Copy destrange
            mybook.Close True
        Next
    End If

    ChDrive SaveDriveDir
    ChDir SaveDriveDir
    Application.ScreenUpdating = True

    Sheets("Main").Select
    Cells(5, 4).Value = FName

    Sheets("CS-CRM Raw Data").Select
    ActiveSheet.Cells(1, 1).Select

Sheets("Raw Data").Protect

End Sub

到目前为止，代码将从此行获取路径：

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)

它会将它写入具有以下行的单元格：

Sheets("Main").Select
Cells(5, 4).Value = FName

但是，每次我尝试获取文件名时都不起作用。我将收到一条错误消息，或者它将再次发布整个路径。有谁知道最好的方法吗？

Answer 1

这是一种将 GetOpenFileName（）的结果解析为三个部分的方法：

1. 路径
2. 文件名
3. 文件扩展名

..

Sub qwerty()
    Dim f As String, Path As String, _
        FileName As String, FileType As String

    f = Application.GetOpenFilename()

    ary = Split(f, "\")
    bry = Split(ary(UBound(ary)), ".")
    ary(UBound(ary)) = ""
    Path = Join(ary, "\")
    FileName = bry(0)
    FileType = bry(1)

    Range("A1") = Path
    Range("A2") = FileName
    Range("A3") = FileType
End Sub

例如：

Answer 2

您还应该记住，他们可以选择多个文件;

Sub getfilenames()
    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
    MultiSelect:=True)

    i = 1
    For n = LBound(FName) To UBound(FName)
        FnameInLoop = Right(FName(n), Len(FName(n)) - InStrRev(FName(n), _
        Application.PathSeparator, , 1))
        Cells(i, 4).Value = FnameInLoop
        i = i + 1
    Next n
End Sub