vba VBA从路径获取文件名并将其存储到单元格
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 
原文地址: http://stackoverflow.com/questions/25038711/
Warning: these are provided under cc-by-sa 4.0 license.  You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Get File Name From Path and Store it to a Cell
提问by user3783788
I'm working on some code that I would like to find the path of a selected file, extract the file name, and then write the file name to a cell on the sheet. Here's what I have so far:
我正在处理一些代码,我想找到所选文件的路径,提取文件名,然后将文件名写入工作表上的单元格。这是我到目前为止所拥有的:
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
So far the code will get the path from this line:
到目前为止,代码将从这一行获取路径:
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
And it will write it to a cell with these lines:
它将用以下几行将其写入单元格:
Sheets("Main").Select
Cells(5, 4).Value = FName
However, every time I try to get it to just get the file name it doesn't work. I'll either get an error message or it will just post the entire path again. Does anyone know the best way to do this?
但是,每次我尝试获取它以获取文件名时,它都不起作用。我会收到一条错误消息,或者它只会再次发布整个路径。有谁知道最好的方法来做到这一点?
回答by Gary's Student
Here is a way to parse the result of GetOpenFileName()into three parts:
下面是一种将GetOpenFileName()的结果解析为三部分的方法:
- path
- filename
- file extension
- 小路
- 文档名称
- 文件扩展名
..
..
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
For example:
例如:


回答by Kokkie
You should also bear in mind that they could select more than 1 file;
您还应该记住,他们可以选择 1 个以上的文件;
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

