|
楼主 |
发表于 2011-8-3 18:02
|
显示全部楼层
原帖由 commander777 于 2011-8-3 12:58 发表
请问版主,如果想将不同内容的CSV(有不相同的列)写入到ACCESS的同一个表中,采用第3种方法该如何操作?谢谢!
Sub 联合查询后导入() '引用Microsoft ActiveX Data Objects 2.x Library
Dim cnn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim myPath$, MyFile$, SQL$, a(), b(), arr(), s$, t$, i%, n%
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\学生成绩.mdb" '连接数据库
Set rs = cnn.Execute("成绩单")
n = rs.Fields.Count
ReDim a(1 To n)
ReDim b(1 To n)
For i = 1 To n
a(i) = rs.Fields(i - 1).Name
If rs.Fields(i - 1).Type <= 5 Then b(i) = 0 Else b(i) = "''"
Next
myPath = ThisWorkbook.Path & "\"
MyFile = Dir(myPath & "*.txt")'csv文本修改为MyFile = Dir(myPath & "*.csv")
Do While MyFile <> "" '创建多个文本文件的联合查询
Set rs = cnn.Execute("[Text;FMT=Delimited;HDR=Yes;DATABASE=" & myPath & ";].[" & MyFile & "]")
ReDim arr(1 To rs.Fields.Count)
For i = 1 To rs.Fields.Count
arr(i) = rs.Fields(i - 1).Name
Next
s = "," & Join(arr, ",") & ","
t = ""
For i = 1 To n
If InStr(s, "," & a(i) & ",") Then '该文本文件存在该字段
t = t & "," & a(i)
Else
t = t & "," & b(i) & " as " & a(i) '该文本文件不存在该字段要添加 '' as 字段或 0 as 字段
End If
Next
t = Mid(t, 2)
If Len(SQL) Then
SQL = SQL & " union all select " & t & " from [Text;FMT=Delimited;HDR=Yes;DATABASE=" & myPath & ";].[" & MyFile & "]"
Else
SQL = "select " & t & " from [Text;FMT=Delimited;HDR=Yes;DATABASE=" & myPath & ";].[" & MyFile & "]"
End If
MyFile = Dir()
Loop
SQL = "insert into 成绩单 select * from (" & SQL & ")" '向access数据表中添加数据语句
cnn.Execute SQL
MsgBox "已经成功将文本文件数据保存为数据库!", vbInformation
cnn.Close
Set cnn = Nothing
End Sub
[ 本帖最后由 zhaogang1960 于 2011-8-4 02:01 编辑 ] |
评分
-
1
查看全部评分
-
|