將文件名從多個工作簿複製到另一個工作簿中的單元格

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