在VBA中将文件名从DIR写入单元格

我将下面的macros附加在Dir中的文件中，并将数据复制到主文件（运行macros）中。 我想要做的也是在主文件中写入数据已经被粘贴到列的顶部（单元格E5）的数据已被复制的文件的名称。

您能否提一些build议…

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

它看起来好像你想要的文件名存储在“myFile”中 。 为了确保请添加一个打印到这一行

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

并检查输出是否真的是你想要的string。

尝试改变

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

至

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

我不确定这条线应该做什么：

 myPath = myPath