[已解决]如何实现txt文件批量导入excel

kfxy

各位老师好，我有个关于利用VBA语句实现txt文件批量导入excel的需求，

共有31个文件，每天一个文件，文件名称类似data_20140807.txt，如何利用VBA实现一次性导入31个文件，一个文件对应一个工作表？

以下是实现单个文件导入excel录制的宏，该宏每次导入一个文件后，需要修改如下宏中注释的内容


例如导入data_20140807.txt内容的宏如下：

Sub 宏1()
'
' 宏1 宏
'
' 快捷键: Ctrl+e
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Administrator\Desktop\DATA\201407\data_20140807.txt" _     //文件名称需要修改
        , Destination:=Range("$A$1"))
        .Name = "data_20140807"   //文件名称需要修改
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWindow.SmallScroll Down:=-42
    Sheets("Sheet38").Select    //sheet38需要修改，每次新增一个工作表
    Sheets("Sheet38").Name = "0807"  //文件的名称与上面的名称一致
    ActiveWindow.SmallScroll Down:=-24
End Sub

例如导入data_20140808.txt内容的宏如下：

Sub 宏1()
'
' 宏1 宏
'
' 快捷键: Ctrl+e
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Administrator\Desktop\DATA\201407\data_20140808.txt" _     //文件名称需要修改
        , Destination:=Range("$A$1"))
        .Name = "data_20140808"   //文件名称需要修改
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWindow.SmallScroll Down:=-42
    Sheets("Sheet39").Select    //sheet39需要修改，每次新增一个工作表
    Sheets("Sheet39").Name = "0808"  //文件的名称与上面的名称一致
    ActiveWindow.SmallScroll Down:=-24
End Sub

最佳答案

月排行榜 / 总排行榜

香川群子

2014-8-12 09:24

下面代码拿去测试一下吧：

1. Sub txt_input()
   
2. 
   
3.     myMonth = InputBox("Input month (last month)", "", Month(Date - 15))
   
4.     '出现对话框-1、要求输入指定月份 默认为上个月 (当日回溯15天所在月份)
   
5. 
   
6.     myPath = InputBox("Input path:", "", "C:\Users\Administrator\Desktop\DATA" & Format(DateSerial(Year(Date - 15), myMonth, 1), "yyyymm"))
   
7.     '出现对话框-2、要求确认指定文件夹路径。 默认为上个月的文件夹
   
8.     '如不是自己想要的文件夹，可以直接在对话框中修改路径
   
9. 
   
10.     '如不是自己需要的，也不想输入，而希望自己任选一个文件夹，那就按取消
    
11.     '于是进入下一步 出现对话框-3、自己选一个文件夹吧。
    
12.     If myPath = "" Then
    
13.         With Application.FileDialog(msoFileDialogFolderPicker)
    
14.             If .Show Then myPath = .SelectedItems(1) Else Exit Sub
    
15.             '此对话框-3 时如果按下取消，就退出结束宏运行。
    
16.         End With
    
17.     End If
    
18.    
    
19.     '选好文件夹以后，下面循环指定月的天数 (能自动计算该月实际天数 30或31  或28/29)
    
20.     For d = 1 To Day(DateSerial(Year(Date - 15), myMonth + 1, 0))
    
21.         myName = "data_" & Format(DateSerial(Year(Date - 15), myMonth, d), "yyyymmdd")
    
22.         '按日期序列生成文件名、格式如："data_20140807"
    
23.         myFile = myPath & "" & myName & ".txt" '生成含完整路径的文件全名
    
24.         With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myFile, Destination:=Range("$A$1"))
    
25.             .Name = myName
    
26.             .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    
27.             '备注 除分列参数需指定以外，其余参数使用默认值即可，不需要全部列出
    
28.         End With        
    
29.         Sheets(Worksheets.Count).Name = Mid(myName, 10, 4) '工作簿末尾新Sheet工作表重新命名 格式如 "0807"
    
30.     Next
    
31. End Sub

复制代码

如果是自己添加工作表 那么代码是：
Sheets.Add After:=Sheets(Worksheets.Count) '在工作簿末尾添加新Sheet工作表
貌似这句用不到。
        

跳转到最佳答案楼层

su45

TXT文件咱不熟，帮顶下！

su45

你把data_20140807.txt上传下！

久保带人i

顶一个，相对有用。

pengyx

1、所有的txt是放在一个文件夹中吗？2、txt用什么符号来分割字段？3、用什么符号表示换行？
这个事不复杂，没附件；没真象哈

香川群子

下面代码拿去测试一下吧：

1. Sub txt_input()
   
2. 
   
3.     myMonth = InputBox("Input month (last month)", "", Month(Date - 15))
   
4.     '出现对话框-1、要求输入指定月份 默认为上个月 (当日回溯15天所在月份)
   
5. 
   
6.     myPath = InputBox("Input path:", "", "C:\Users\Administrator\Desktop\DATA" & Format(DateSerial(Year(Date - 15), myMonth, 1), "yyyymm"))
   
7.     '出现对话框-2、要求确认指定文件夹路径。 默认为上个月的文件夹
   
8.     '如不是自己想要的文件夹，可以直接在对话框中修改路径
   
9. 
   
10.     '如不是自己需要的，也不想输入，而希望自己任选一个文件夹，那就按取消
    
11.     '于是进入下一步 出现对话框-3、自己选一个文件夹吧。
    
12.     If myPath = "" Then
    
13.         With Application.FileDialog(msoFileDialogFolderPicker)
    
14.             If .Show Then myPath = .SelectedItems(1) Else Exit Sub
    
15.             '此对话框-3 时如果按下取消，就退出结束宏运行。
    
16.         End With
    
17.     End If
    
18.    
    
19.     '选好文件夹以后，下面循环指定月的天数 (能自动计算该月实际天数 30或31  或28/29)
    
20.     For d = 1 To Day(DateSerial(Year(Date - 15), myMonth + 1, 0))
    
21.         myName = "data_" & Format(DateSerial(Year(Date - 15), myMonth, d), "yyyymmdd")
    
22.         '按日期序列生成文件名、格式如："data_20140807"
    
23.         myFile = myPath & "" & myName & ".txt" '生成含完整路径的文件全名
    
24.         With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myFile, Destination:=Range("$A$1"))
    
25.             .Name = myName
    
26.             .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    
27.             '备注 除分列参数需指定以外，其余参数使用默认值即可，不需要全部列出
    
28.         End With        
    
29.         Sheets(Worksheets.Count).Name = Mid(myName, 10, 4) '工作簿末尾新Sheet工作表重新命名 格式如 "0807"
    
30.     Next
    
31. End Sub

复制代码

如果是自己添加工作表 那么代码是：
Sheets.Add After:=Sheets(Worksheets.Count) '在工作簿末尾添加新Sheet工作表
貌似这句用不到。
        

kfxy

香川群子 发表于 2014-8-12 09:24
下面代码拿去测试一下吧：如果是自己添加工作表 那么代码是：
Sheets.Add After:=Sheets(Worksheets.Count ...

谢谢哦，貌似还不行呀！

kfxy

香川群子 发表于 2014-8-12 09:24
下面代码拿去测试一下吧：如果是自己添加工作表 那么代码是：
Sheets.Add After:=Sheets(Worksheets.Count ...

谢谢，已经使用你提供的代码修改实现。

现在VBA的实现代码如下：

    Sub txt_input()

        myMonth = InputBox("Input month (last month)", "", Month(Date - 15))
        '出现对话框-1、要求输入指定月份 默认为上个月 (当日回溯15天所在月份)

        myPath = InputBox("Input path:", "", "C:\Users\Administrator\Desktop\DATA\" & Format(DateSerial(Year(Date - 15), myMonth, 1), "yyyymm"))
        '出现对话框-2、要求确认指定文件夹路径。 默认为上个月的文件夹
        '如不是自己想要的文件夹，可以直接在对话框中修改路径

        '如不是自己需要的，也不想输入，而希望自己任选一个文件夹，那就按取消
        '于是进入下一步 出现对话框-3、自己选一个文件夹吧。
        If myPath = "" Then
            With Application.FileDialog(msoFileDialogFolderPicker)
                If .Show Then myPath = .SelectedItems(1) Else Exit Sub
                '此对话框-3 时如果按下取消，就退出结束宏运行。
            End With
        End If
      
        '选好文件夹以后，下面循环指定月的天数 (能自动计算该月实际天数 30或31  或28/29)
        For d = 1 To Day(DateSerial(Year(Date - 15), myMonth + 1, 0))
            myName = "data_" & Format(DateSerial(Year(Date - 15), myMonth, d), "yyyymmdd")
            '按日期序列生成文件名、格式如："data_20140807"
            myFile = myPath & "\" & myName & ".txt" '生成含完整路径的文件全名
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myFile, Destination:=Range("$A$1"))
                .Name = myName
                .TextFileCommaDelimiter = True
                .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
                '备注 除分列参数需指定以外，其余参数使用默认值即可，不需要全部列出
            End With
            Sheets(Worksheets.Count).Name = Mid(myName, 10, 4) '工作簿末尾新Sheet工作表重新命名 格式如 "0807"
            Sheets.Add After:=Sheets(Worksheets.Count)
        Next
    End Sub

amiaosheng

老师的VBA太强大了