將文件名從幾個工作簿復制到另一個工作簿中的單元格

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

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 。

我還添加了對Sheet（“ Combined”）的引用，以提高可讀性：

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