将文件名从 VBA 中的 DIR 写入单元格答案

【问题标题】：Write Filename to cell from DIR in VBA将文件名从 VBA 中的 DIR 写入单元格
【发布时间】：2017-09-15 08:49:36
【问题描述】：

我在下面附加了一个宏，它循环遍历 Dir 中的文件并将数据复制到一个主文件（宏从中运行）。我想要做的也是在主文件中写入数据已从其粘贴到的列顶部（单元格 E5）复制数据的文件的名称。

请指教...

子 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

【问题讨论】：

如果您为您的问题创建了一个最小、完整且可验证的示例，这将有所帮助（请参阅stackoverflow.com/help/mcve）
另外，你自己尝试过什么吗？（提示：查看Dir()函数的帮助）

标签： vba excel directory filenames

【解决方案1】：

您想要的文件名看起来好像存储在 "myFile" 中。为确保请在此行添加打印

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

并检查输出是否真的是你想要的字符串。

尝试改变

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

【讨论】：