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

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

将文本文件从目录1导入我的活动工作簿到特定工作表

从导入的文本文件复制提取的数据，并将值粘贴到另一个工作表中（我必须执行一些计算）

将导入的文件移动到目录2

对于目录1中的下一个文本文件，请返回步骤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。这是一次一个循环遍历所有文件，并在导入数据后移动文件，这使我丢失了数据。任何帮助都将不胜感激

您可以使用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

子导入（）
Application.ScreenUpdating=False
Application.DisplayAlerts=False
“清除以前的数据
表1.激活
ActiveSheet.UsedRange.Clear
范围（“A1”）。选择
'路径和文件名的变量
将当前路径设置为字符串
将newPath设置为字符串
将当前文件设置为字符串
currentPath=“\\directory\”
newPath=“\\NewDirectory\”
'获取第一个文件
currentFile=Dir（currentPath&“*.txt”）
当前文件“”时执行此操作
'导入文本文件
使用ActiveSheet.QueryTables.Add（连接：=_
“TEXT；”¤tPath¤tFile_
目的地：=范围（“$A$1”））
.Name=“数据”
.FieldNames=True
.TextFileTabDelimiter=True
.TextFileColumnDataTypes=数组（3,1,1,1,1,1,1,1,1,1,1,1,1,1）
.Refresh BackgroundQuery:=False
以
ActiveSheet.QueryTables（1）.删除
'将值复制到主数据表
表3.范围（“A2:P2”）。副本
Sheet6.范围（“A”&行数）.结束（xlUp）.偏移量（1，0）.粘贴特殊xlPasteValues
表6.激活
'移动文件
将currentPath和currentFile命名为newPath和currentFile
'获取下一个文件
currentFile=Dir
环
Application.ScreenUpdating=True
Application.DisplayAlerts=True
端接头

非常感谢您！这就成功了！（我必须调整我的“清除以前的数据”代码，以便将其向下移动，使其在获取第一个文件后下降。）