用ExcelVBA将多个列数不完全相同的文本文件或csv数据导入到access

TomingTang · 发表于 2014-4-24 18:02

zhaogang1960 发表于 2014-4-24 16:11
省字段没有发现问题，加一个参数imex=1试试
请看附件

zhaogang老师，忘了告诉你，创建时间列和完成时间列等所有工作列都有可能是空白的，我会把access 字段类型中字段都设置为“允许为空”的。我想用sql那种case when 进行处理，可是不行。再次麻烦了。

zhaogang1960 · 发表于 2014-4-24 18:25

TomingTang 发表于 2014-4-24 18:02
zhaogang老师，忘了告诉你，创建时间列和完成时间列等所有工作列都有可能是空白的，我会把access 字段类型 ...

请上传这样的附件看看

TomingTang · 发表于 2014-4-24 18:33

zhaogang1960 发表于 2014-4-24 18:25
请上传这样的附件看看

导入csv文件access联合查询后导入(csv文件非连接状态)-使用别名.zip (38.39 KB, 下载次数: 2)
请查看，access中字段都改成容许为空
我想改成：

Sub 联合查询后导入xx() '引用Microsoft ActiveX Data Objects 2.x Library
Dim cnn As New ADODB.Connection
Dim myPath$, MyFile$, SQL$, s$
s = "客户代码,处理号,订单号,服务类型,处理点,[重量(g)] as 重量,[长度(cm)] as 长度,[宽度(cm)] as 宽度,[高度(cm)] as 高度,[体积(cm^3)] as 体积,国家,省,城市,创建时间=case when 创建时间 is not null then format(创建时间,'yyyy-m-d') else 0 end,完成时间= case when 完成时间 is null then format(完成时间,'yyyy-m-d') else 0 end"
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\expackage.mdb" '连接数据库
myPath = ThisWorkbook.Path & ""
MyFile = Dir(myPath & "*.csv")
Do While MyFile <> "" '创建多个文本文件的联合查询
If Len(SQL) Then
SQL = SQL & " union all select " & s & " from [Text;FMT=Delimited;imex=1;HDR=Yes;DATABASE=" & myPath & ";].[" & MyFile & "]"
Else
SQL = "select " & s & " from [Text;FMT=Delimited;imex=1;HDR=Yes;DATABASE=" & myPath & ";].[" & MyFile & "]"
End If
MyFile = Dir()
Loop
SQL = "insert into expackage select * from (" & SQL & ")" '向access数据表中添加数据语句
cnn.Execute SQL
MsgBox "已经成功将文本文件数据保存为数据库！", vbInformation
cnn.Close
Set cnn = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2014-4-24 18:41

一、数据库很多字段都要修改是否必需
二、文本文件不真实，下端有很多空行

zhaogang1960 · 发表于 2014-4-24 18:42

修改设置；增加条件客户代码 is not null

Sub 联合查询后导入() '引用Microsoft ActiveX Data Objects 2.x Library
Dim cnn As New ADODB.Connection
Dim myPath$, MyFile$, SQL$, s$
s = "客户代码,处理号,订单号,服务类型,处理点,[重量(g)] as 重量,[长度(cm)] as 长度,[宽度(cm)] as 宽度,[高度(cm)] as 高度,[体积(cm^3)] as 体积,国家,省,城市,创建时间,完成时间"
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\expackage.mdb" '连接数据库
myPath = ThisWorkbook.Path & ""
MyFile = Dir(myPath & "*.csv")
Do While MyFile <> "" '创建多个文本文件的联合查询
If Len(SQL) Then
SQL = SQL & " union all select " & s & " from [Text;FMT=Delimited;imex=1;HDR=Yes;DATABASE=" & myPath & ";].[" & MyFile & "] where 客户代码 is not null"
Else
SQL = "select " & s & " from [Text;FMT=Delimited;imex=1;HDR=Yes;DATABASE=" & myPath & ";].[" & MyFile & "] where 客户代码 is not null"
End If
MyFile = Dir()
Loop
SQL = "insert into expackage select * from (" & SQL & ")" '向access数据表中添加数据语句
cnn.Execute SQL
MsgBox "已经成功将文本文件数据保存为数据库！", vbInformation
cnn.Close
Set cnn = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2014-4-24 18:43

请测试附件

导入csv文件access联合查询后导入(csv文件非连接状态)-使用别名.rar (33.97 KB, 下载次数: 38)

TomingTang · 发表于 2014-4-24 18:57

zhaogang1960 发表于 2014-4-24 18:41
一、数据库很多字段都要修改是否必需
二、文本文件不真实，下端有很多空行

非常感谢zhaogang老师一次一次的帮助。‘
一、其实当我一个一个导进去时，貌似没有出现以上的错误，原数据就是csv文档就是创建时间、完成时间这两列数据有偏移就是q列的数据移到p列，这样发生移动的数据行很少，10万也就1、2条
对于很多字段修改，是没有的。另外，国家、省、城市，这几个字段是地址，有缺漏很正常的。
二、“文本文件不真实”什么意思，不太懂，我上传的附件是删了数据的，每个表都有10几万条数据，无法上传的。
你认为是文档下部空行造成的。
再次感谢，我看看，测试，我理解你的编程思想了。谢谢。

zhaogang1960 · 发表于 2014-4-24 19:04

TomingTang 发表于 2014-4-24 18:57
非常感谢zhaogang老师一次一次的帮助。‘
一、其实当我一个一个导进去时，貌似没有出现以上的错误，原数 ...

先把取得各个文件的联合查询只是一个思路，速度是否快，或是否更可靠还不好说，如果你认为逐个文件导入好，请使用该方法

donghua200 · 发表于 2015-10-20 10:22

对csv文件格式还有要求，必须是csv(逗号分隔)

		自动登录	找回密码
密码			免费注册

[求助] 用ExcelVBA将多个列数不完全相同的文本文件或csv数据导入到access