Question

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

你能告诉我......

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

并检查输出实际上是否是您想要的字符串。

尝试更改

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

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

1 个答案: