VBAのDIRからセルにファイル名を書き込む

Question

Dirのファイルをループするマクロがあります。マクロが実行されたマスターファイルにデータがコピーされます。私がやりたいことは、マスターファイルに、データがコピーされた列の先頭からデータがコピーされたファイルの名前（セルE5）を書き込むことです。

あなたが欲しいファイル名が"のmyFile"に格納されているかのように見えます...

サブ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

をアドバイスしてもらえます。 はこのライン

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

にプリントを追加し、出力が実際にあなたがしたい文字列であるかどうかを確認してください確認します。

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

に

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

を変更しようと、私はこの行が何をすべきかわからない：

myPath = myPath