Question

我正在尝试开发一个执行以下操作的宏

将DIRECTORY 1中的文本文件导入我的活动工作簿到特定工作表
从导入的文本文件中复制提取的数据，并将值粘贴到另一个工作表中（我必须执行一些计算）
将导入的文件移至DIRECTORY 2
返回步骤1，查看DIRECTORY 1中的下一个文本文件

我不想一次将所有文本文件复制到一个工作表中，因为不会总是有相同数量的文本文件。

Sub Import()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

' Clear previous data

    Sheet1.Activate
    ActiveSheet.UsedRange.Clear
    Range("A1").Select

' Import text file

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;\\directory\test.txt", _
        Destination:=Range("$A$1"))
        .Name = "Data"
        .FieldNames = True
        .TextFileTabDelimiter = True
        .TextFileColumnDataTypes = Array(3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
    End With

    ActiveSheet.QueryTables(1).Delete

' Copy values to main data table

    Sheet3.Range("A2:P2").Copy

    Sheet6.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    Sheet6.Activate

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

我已经开发了第2步，并且我已经为单个文件开发了第1步。它是一次循环遍历所有文件，并在导入数据后移动文件，我丢失了。任何帮助将不胜感激！

Answer 1

您可以使用Dir函数获取每个文件，使用Name函数移动它们。

Sub Import()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

' Clear previous data

    Sheet1.Activate
    ActiveSheet.UsedRange.Clear
    Range("A1").Select
'variables for paths and file name
Dim currentPath As String
Dim newPath As String
Dim currentFile As String
currentPath = "\\directory\"
newPath = "\\NewDirectory\"
'get the first file
 currentFile = Dir(currentPath & "*.txt")
 Do While currentFile <> ""
' Import text file
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & currentPath & currentFile, _
        Destination:=Range("$A$1"))
        .Name = "Data"
        .FieldNames = True
        .TextFileTabDelimiter = True
        .TextFileColumnDataTypes = Array(3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
    End With

    ActiveSheet.QueryTables(1).Delete

' Copy values to main data table

    Sheet3.Range("A2:P2").Copy

    Sheet6.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    Sheet6.Activate

    'move the file
    Name currentPath & currentFile As newPath & currentFile
    'get the next file
    currentFile = Dir
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

将文件夹中的所有文本文件一次导入Excel，然后移动文件

1 个答案: