关于批量导入txt文本的问题

dtxczjzmp

把近两佰个的txt文件批量导入excel 工作簿，并且每个txt文件导成一张工作表，工作表以txt文件名命名，具体导成样式祥见附件 r20131101.rar (12.17 KB, 下载次数: 20)

2013-11-20 19:27 上传

点击文件名下载附件

，即导成附件的工作簿一样，请高手帮助，谢谢！


该贴已经同步到 dtxczjzmp的微博

曼婷

弄了一下，试下行不。基本思路是：1、按读ECXEL一样，读取TXT。2、将每一行的数据拆分出来。3、改表的名字。

chxw68

1. Sub test()
   
2.   Dim fso As New FileSystemObject
   
3.   Dim cnn As New ADODB.Connection
   
4.   Dim rs As New ADODB.Recordset
   
5.   Dim sql As String
   
6.   Dim strconn As String
   
7.   Dim ws As Worksheet
   
8.   
   
9.   If MsgBox("提取数据将删除本工作簿除[总表]以外的其他数据表并重新生成，确定提取吗？", vbOKCancel + vbCritical + vbDefaultButton2, "提示") = vbCancel Then
   
10.     Exit Sub
    
11.   End If
    
12.   
    
13.   Dim mybook As String
    
14.   Dim mysheet As String
    
15.   
    
16.   Application.DisplayAlerts = False
    
17.   Application.ScreenUpdating = False
    
18.   
    
19.   For Each ws In Worksheets
    
20.     If ws.Name <> "总表" Then
    
21.       ws.Delete
    
22.     End If
    
23.   Next
    
24.   
    
25.   mybook = ThisWorkbook.FullName
    
26.   mysheet = "sheet1"
    
27.   
    
28.   strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & ";Extended Properties=""TEXT;HDR=YES;IMEX=1"";"
    
29.   cnn.Open strconn
    
30.   
    
31.   Set f = fso.GetFolder(ThisWorkbook.Path)
    
32.   
    
33.   For Each wj In f.Files
    
34.     If wj.Name Like "*.txt" Then
    
35.       Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    
36.       ws.Name = Left(wj.Name, Len(wj.Name) - 4)
    
37.       sql = "select * from " & wj.Name
    
38.       rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
    
39.       For i = 0 To rs.Fields.Count - 1
    
40.         ws.Cells(1, i + 1) = rs.Fields(i).Name
    
41.       Next
    
42.       ws.Range("a2").CopyFromRecordset rs
    
43.       With Columns("A:A")
    
44.         .NumberFormatLocal = "0_ "
    
45.         .EntireColumn.AutoFit
    
46.       End With
    
47.       rs.Close
    
48.     End If
    
49.   Next
    
50.       
    
51.   Application.DisplayAlerts = True
    
52.   Application.ScreenUpdating = True
    
53.   cnn.Close
    
54.   Set fso = Nothing
    
55.   Set cnn = Nothing
    
56. End Sub

复制代码

chxw68

使用ADO+SQL做的，不完全打开文件提取数据，在文件数量多时速度比较快，你试一试。

dtxczjzmp

chxw68 发表于 2013-11-20 21:02
使用ADO+SQL做的，不完全打开文件提取数据，在文件数量多时速度比较快，你试一试。

首先感谢您的帮助！假如导入txt文件后，在左边插入一列单位名称的值是为插入前的range("B2"),并且把第二行删除，代码该如何改？ r20131101.rar (24.77 KB, 下载次数: 2)

2013-11-22 13:05 上传

点击文件名下载附件

chxw68

dtxczjzmp 发表于 2013-11-22 13:05
首先感谢您的帮助！假如导入txt文件后，在左边插入一列单位名称的值是为插入前的range("B2"),并且把第二行 ...

是导入文件后，在B列插入一列单位名称吗？单位名称是什么？要删除表格第二行吗？

张雄友

chxw68 发表于 2013-11-20 21:00

Dim fso As New FileSystemObject  用户类型未定义，要引用哪个项目的？

chxw68

张雄友 发表于 2013-11-22 18:16
Dim fso As New FileSystemObject  用户类型未定义，要引用哪个项目的？

在VBE窗口中，单击“工具”菜单，执行其中的“引用”菜单，打开“引用-VBAProject"对话框，选择其中的“Microsoft Scripting Runtime"，单击确定。

张雄友

chxw68 发表于 2013-11-22 18:29
在VBE窗口中，单击“工具”菜单，执行其中的“引用”菜单，打开“引用-VBAProject"对话框，选择其中的“M ...

引用后，又到这句未定义了：Dim cnn As New ADODB.Connection

chxw68

张雄友 发表于 2013-11-22 18:37
引用后，又到这句未定义了：Dim cnn As New ADODB.Connection

引用“Microsoft Active Data Objects 2.8 Library"