用vba方法将txt原始文件导入到access中，查询后导出到excel中

text.zip (271.27 KB)
txt文件
下载次数: 9

复制内容到剪贴板

代码:

Sub 导入()
'需引用ADO库和Office库
'定义ADO对象和打开文件拾取器对象
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim fd As FileDialog
'定义文件名和文件路径。
Dim FileName As String
Dim FilePath As String
'定义偏移量，以便根据偏移位置把数据导入到指定位置。
Dim rcd As Long
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
'允许多个选取，建议把所需文件放在同一个文件夹里。
.AllowMultiSelect = True
'设置打开文件类型，以免发生错误
.Filters.Clear
.Filters.Add "文本文件(*.txt)", "*.txt"
'初始化视图
.InitialView = msoFileDialogViewDetails
End With
'初始化偏移量
rcd = 0
'如果选择
If fd.Show = -1 Then
'统计所选文件数
    For i = 1 To fd.SelectedItems.Count
'提取文件名和文件路径字符串，InStrRev(fd.SelectedItems(i), "\", -1)表示逆向获取"\"的位置
   FileName = Right(fd.SelectedItems(i), Len(fd.SelectedItems(i)) - InStrRev(fd.SelectedItems(i), "\", -1))
   FilePath = Left(fd.SelectedItems(i), InStrRev(fd.SelectedItems(i), "\", -1))
'打开ADO链接和数据集，这两项是关键。
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath & ";Extended Properties=""text;HDR=No;FMT=Delimited;"";"
rst.Open "Select * From [" & FileName & "]", cnn, adOpenStatic, adLockReadOnly, adCmdText
'复制数据集到指定位置
Sheet1.[a1].Offset(0, rcd).CopyFromRecordset rst
rcd = rcd + 1
'关闭数据集和链接以便下一次执行
rst.Close
cnn.Close
    Next i
End If
End Sub