如何粘贴打开文件的文件名并填写？

Question

我正在尝试获取打开文件的文件名并将该文件名粘贴到行末尾。

我试过了

WSdest.Cells(WSdest.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = FileToOpen

给出文件名，但仅将其放在表格的一行上。我还得到文件路径而不仅仅是名称。我该如何修剪这个？

我预计行会填满。

Sub Get_Data_From__File()

    Dim WScopy As Worksheet
    Dim WSdest As Worksheet
    Dim desWB As Workbook
    Dim FileToOpen As Variant
    Dim cRow As Long
    
    Set desWB = ThisWorkbook
    Set WSdest = desWB.Sheets("Sheet1")

    Application.ScreenUpdating = False
    
    FileToOpen = Application.GetOpenFilename(Title:="Browse for Incident File", FileFilter:="Excel Files (*.xls*), *xls*")
    
    If FileToOpen <> False Then
        
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        
        LastRow = OpenBook.Sheets(1).Range("A1048576").End(xlUp).Row
        
        OpenBook.Sheets(1).Range("A2:A" & LastRow).Copy
        WSdest.Cells(WSdest.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
        
        OpenBook.Sheets(1).Range("E2:E" & LastRow).Copy
        WSdest.Cells(WSdest.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
        
        OpenBook.Sheets(1).Range("AF2:AF" & LastRow).Copy
        WSdest.Cells(WSdest.Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
        
        WSdest.Cells(WSdest.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = FileToOpen
     
        ActiveWorkbook.Close False
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    
   End If

End Sub

Answer 1

• RecentFiles

  集合代表最近打开的文件列表。

• ThisWorkbook

  是当前宏代码运行的工作簿。

• 使用

  Split

  提取文件名。当然，您也可以使用 VBA 字符串函数（

  Left

  和

  InStrRev

  ）来获取它。

微软文档：

Range.End 属性 (Excel)

Application.RecentFiles 属性 (Excel)

Option Explicit

Sub GetRecentFiles()
    Dim recentFiles As recentFiles
    Dim file, aFile
    Dim iRow As Long
    ' Get row# of the first blank cell 
    iRow = Cells(Rows.Count, "C").End(xlUp).Row
    If Len(Cells(iRow, "C")) > 0 Then iRow = iRow + 1
    ' Check if there are recent files
    If Application.recentFiles.Count > 0 Then
        Set recentFiles = Application.recentFiles
        ' Loop through the recent files
        For Each file In recentFiles
            aFile = Split(file.Name, "\")
            Cells(iRow, "C").Value = aFile(UBound(aFile))
            iRow = iRow + 1
        Next file
        Cells(iRow, "C").Value = ThisWorkbook.Name
    Else
        MsgBox "No recent files found."
    End If
End Sub