将文件名从多个工作簿复制到另一个工作簿中的单元格

Question

我有一个包含大量工作簿的文件夹，其中需要将文件名（以及其他一些数据）复制到主工作簿。我找到了一个导入数据的代码，但似乎无法导入文件名。

经过“'>>>>>>改编此部分”我试图编写一些代码来复制和粘贴文件名，但它似乎不起作用。

我用一部分外“” >>>>>>适应这部分”复制一些其他的数据，所以我只需要一些代码，以适应在我不工作的代码:)

Sub Import_to_Master() 
    Dim sFolder As String 
    Dim sFile As String 
    Dim wbD As Workbook, wbS As Workbook 

    Application.ScreenUpdating = False 
    Set wbS = ThisWorkbook 
    sFolder = wbS.Path & "\" 

    sFile = Dir(sFolder) 
    Do While sFile <> "" 

     If sFile <> wbS.Name Then 
      Set wbD = Workbooks.Open(sFolder & sFile) 

      ' >>>>>> Adapt this part 

      WName = ActiveWorkbook.Name 
      WName.Copy 
      Sheets("Combined").Range("N" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
      Application.CutCopyMode = False 

      ' >>>>>> 

      wbD.Close savechanges:=True 'close without saving 

     End If 

     sFile = Dir 'next file 
    Loop 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

insted的

Sub Import_to_Master() 

    Dim sFolder As String 
    Dim sFile As String 
    Dim wbD As Workbook, wbS As Workbook 

    Application.ScreenUpdating = False 
    Set wbS = ThisWorkbook 
    sFolder = wbS.Path & "\" 

    sFile = Dir(sFolder) 
    Do While sFile <> "" 

     If sFile <> wbS.Name Then 
      Set wbD = Workbooks.Open(sFolder & sFile) 

      ' >>>>>> Adapt this part 

      wbS.Sheets("Combined").Range("N" & wbS.Sheets("Combined").Rows.Count).End(xlUp).Offset(1, 0).Value = sFile 

      ' >>>>>> 

      wbD.Close savechanges:=True 'close without saving 

     End If 

     sFile = Dir 'next file 
    Loop 
    Application.ScreenUpdating = True 
End Sub 

Answer 2

您可以直接使用对象wbD及其属性.Name。

我也加入到该表（ “组合”），用于更好的可读性的参考：

Sub Import_to_Master() 
    Dim sFolder As String 
    Dim sFile As String 
    Dim wbD As Workbook, wbS As Workbook 
    Dim wSc As Worksheet 

    Application.ScreenUpdating = False 
    Set wbS = ThisWorkbook 
    '''Define the sheet 
    Set wSc = wbS.Sheets("Combined") 
    sFolder = wbS.Path & "\" 

    sFile = Dir(sFolder) 
    Do While sFile <> "" 

     If sFile <> wbS.Name Then 
      Set wbD = Workbooks.Open(sFolder & sFile) 

      ' >>>>>> Adapt this part 
      wSc.Range("N" & wSc.Rows.Count).End(xlUp).Offset(1, 0).value = wbD.Name 

      ' >>>>>> 

      wbD.Close savechanges:=True 'close without saving 

     End If 

     sFile = Dir 'next file 
    Loop 
    Application.ScreenUpdating = True 
End Sub