在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的單元格

回答

相關問題