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

我有下面的宏，它通过Dir中的文件循环并将数据复制到主文件（宏从其运行）中。我想要做的也是在主文件中写入从粘贴到列的顶部数据（单元格E5）复制数据的文件的名称。在VBA中将文件名写入DIR的单元格

能否请您指教...

子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

来源

2017-04-19 d_nails_93

如果您创建这将有助于最小的，完整的，可证实的问题（请参阅http://stackoverflow.com/help/mcve） – SteveES

另外，你有没有尝试过自己？（提示：查看'Dir（）'函数的帮助） – SteveES

它看起来好像你想要的文件名存储在“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

来源

2017-04-19 08:49:17

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

回答

相关问题