Schreiben Dateiname an Zelle von DIR in VBA

Question

Ich habe das Makro unten angehängt, das durchläuft Dateien in einem Dir und kopiert Daten in eine Master-Datei (aus der das Makro ausgeführt wird). Ich möchte auch in die Master-Datei schreiben, den Namen der Datei, von der die Daten kopiert wurden, oben in der Spalte, in die sie eingefügt wurde (Zelle E5).

Könnten Sie bitte beraten ...

Sub Import_Data()

' PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 

Dim WB As Workbook 
Dim wbThis As Workbook 
Dim myPath As String 
Dim myFile As String 
Dim myExtension As String 
Dim FldrPicker As FileDialog 

Set wbThis = ActiveWorkbook 

' Optimize Macro Speed 
Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 

' Retrieve Target Folder Path From User 
MsgBox "Please select Faro Scan Data Folder" 

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) 
With FldrPicker 
    .Title = "Select A Target Folder" 
    .AllowMultiSelect = False 
    If .Show <> -1 Then GoTo NextCode 
    myPath = .SelectedItems(1) & "\" 
End With 

' In Case of Cancel 
NextCode: 
myPath = myPath 
If myPath = "" Then GoTo ResetSettings 

' Target File Extension (must include wildcard "*") 
myExtension = "*.xls" 

' Target Path with Ending Extention 
myFile = Dir(myPath & myExtension) 

' Loop through each Excel file in folder 
Do While myFile <> "" 

    ' Set variable equal to opened workbook 
    Set WB = Workbooks.Open(Filename:=myPath & myFile) 

    ' Ensure Workbook has opened before moving on to next line of code 
    DoEvents 

    ' Copy data from target workbook.... 
    WB.Activate 
    Application.CutCopyMode = False 
    Range("D8:D377").Copy 
    wbThis.Activate 
    Sheets("Faro Scan Data").Select 
    Range("E5").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Application.CutCopyMode = False 

    ' Insert column for next data set 
    Columns("E:E").Select 
    Selection.Insert Shift:=xlToRight 

    ' Format column for new dataset 
    Columns("I:I").Select 
    Selection.Copy 
    Columns("E:E").Select 
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 

    ' Close Workbook 
    WB.Close SaveChanges:=False 

    ' Ensure Workbook has closed before moving on to next line of code 
    DoEvents 

    ' Get next file name 
    myFile = Dir 
Loop 

' Message Box when tasks are completed 
MsgBox "Task Complete!" 

    ResetSettings: 
' Reset Macro Optimization Settings 
Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

MsgBox "Remeber to enter column headings!" 

End Sub 

Answer 1

Es sieht aus, als ob der Dateiname wird in "myFile" gespeichert werden soll. Um sicher zu gehen Sie einen Druck auf diese Linie

myFile = Dir(myPath & myExtension) 
Debug.Print myfile 

und prüfen Sie hinzufügen, wenn der Ausgang tatsächlich wollen, dass die Zeichenfolge, die Sie ist.

Try

Sheets("Faro Scan Data").Select 
Range("E5").Select 
PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 

zu

Sheets("Faro Scan Data").Select 
Range("E5").Value = myFile 
Range("E6").Select 
PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 

Und ich bin nicht sicher, was diese Linie tun sollte sich ändern:

myPath = myPath