ADO导入数据遇到极大困难！

wtqzhjb · 发表于 2011-7-2 11:15

各位朋友，导入数据遇到很大困难，紧急求助：
VBA 不打开文件而导入数据（是不是ado?)

1、如果P1为“周考”，导入周考文件夹下每个文件的数据（包括姓名、班级、一卷二卷成绩。格式已经设置好，一样的）到本表对应位置。

2、如果P1为“月考”
（1）先导入月考文件夹下“一卷机读卡”的所有一卷数据，到本表对应位置（对应到每科的一卷成绩单元格）。
（2）然后导入月考文件夹下的分班二卷成绩到本表（对应到本表二卷分数单元格。）
这一步的关键：
需要按照第（1）步，一卷成绩的姓名、班级，逐一对比，对应导入相关人员的二卷（如果二卷分数为空白或0，一律导入为0）。
如果存在有二卷，而没有一卷成绩的，请也导入他的姓名、班级、并导入二卷成绩（这里一卷不管他）。

难度很大，简直不会，特求助高手相救，深表谢意！

具体见附件（一个独立文件，两个文件夹下，还有几个文件，附件齐备），在线等待。

wtqzhjb · 发表于 2011-7-2 12:29

兄弟伙些，帮帮我啊！
整不起，恼火哦

wtqzhjb · 发表于 2011-7-2 12:31

SQL语句一窍不通，窍窍不通

zhaogang1960 · 发表于 2011-7-2 13:19

问题交待的好像不是很清楚，下面代码是第一步，先看看是不是这样？
Private Sub CommandButton1_Click()
Dim Mypath$
Mypath = ThisWorkbook.Path & "\" & [p1]
If Dir(Mypath, vbDirectory) = "" Then
      MsgBox "文件夹不存在，请检查！", vbInformation
End If
ActiveSheet.UsedRange.Offset(3).ClearContents
If [p1] = "周考" Then
      Call 周考(Mypath)
ElseIf [p1] = "月考" Then
      Call 月考(Mypath)
End If
End Sub

Sub 周考(Mypath$)
Dim MyFile$, SQL$, m&
Mypath = Mypath & "\"
MyFile = Dir(Mypath & "*.xls")
Set cnn = CreateObject("adodb.connection")
Do While Len(MyFile)
      m = m + 1
      If m = 1 Then
         cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no';data source=" & Mypath & MyFile
         SQL = "select * from [sheet1$a4:n65536] where f2 is not null"
      Else
         SQL = SQL & " union all select * from [Excel 8.0;hdr=no;Database=" & Mypath & MyFile & "].[sheet1$a4:n65536] where f2 is not null"
      End If
   MyFile = Dir
Loop
[a4].CopyFromRecordset cnn.Execute(SQL)
cnn.Close
Set cnn = Nothing
End Sub

Sub 月考(Mypath$)
Dim MyFile$, SQL$, m&, s$
Mypath = Mypath & "\"
MyFile = Dir(Mypath & "*.xls")
Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no';data source=" & Mypath & "一卷机读卡.xls"
s = "select * from [sheet1$a2:h65536] where f2 is not null"
Do While Len(MyFile)
      If MyFile <> "一卷机读卡.xls" Then
         m = m + 1
         If m = 1 Then
            SQL = "select * from [Excel 8.0;hdr=no;Database=" & Mypath & MyFile & "].[sheet1$a4:h65536] where f2 is not null"
         Else
            SQL = SQL & " union all select * from [Excel 8.0;hdr=no;Database=" & Mypath & MyFile & "].[sheet1$a4:h65536] where f2 is not null"
         End If
      End If
   MyFile = Dir
Loop
SQL = "select a.f1,a.f2,b.f3,a.f3,b.f4,a.f4,b.f5,a.f5,b.f6,a.f6,b.f7,a.f7,b.f8,a.f8 from (" & SQL & ") a left join (" & s & ") b on a.f2=b.f2"
[a4].CopyFromRecordset cnn.Execute(SQL)
cnn.Close
Set cnn = Nothing
End Sub

[ 本帖最后由 zhaogang1960 于 2011-7-2 14:19 编辑 ]

zhaogang1960 · 发表于 2011-7-2 13:21

请看附件：

导入数据.rar (37.76 KB, 下载次数: 40)

[ 本帖最后由 zhaogang1960 于 2011-7-2 14:20 编辑 ]

wtqzhjb · 发表于 2011-7-2 18:51

哇塞，凶，真的凶！咋这么厉害！完全正确！

wtqzhjb · 发表于 2011-7-2 21:05

帅呆了，啧啧啧，好，赞！！！

wtqzhjb · 发表于 2011-7-16 00:43

原帖由 zhaogang1960 于 2011-7-2 13:21 发表
请看附件：
950042

zhaogang1960老师你好：
非常感谢前次您的帮助。但是现在我又发现一个问题：
就是如果班级虽然不同，但是姓名却相同，这种情况下，由于没有将班级和姓名“捆绑”，就出现了错误，表现为
同一个人，导入了两次，分别是导入不同班级的两个成绩，这样两个人（同一姓名）就有四个重复名字（各自在不同的班级，两个不同的成绩）。
如何修改下程序，防止这一错误？
请老师在帮下忙，万分感激！

wtqzhjb · 发表于 2011-7-16 00:46

原帖由 zhaogang1960 于 2011-7-2 13:21 发表
请看附件：
950042

如同附件。
错误表现比如
班级姓名成绩
1       张三  100
2    张三 200
导入后就出现了这样的情况：
班级姓名成绩
1       张三 100
1       张三 200
2       张三 100
2       张三 200

如何纠正？
谢谢！

wtqzhjb · 发表于 2011-7-16 00:53

把zhaoguang老师的附件数据修改了下，更能显示问题，便于说明。

请老师帮忙看下，咋整？重复耶……
非常感谢您的不吝赐教，谢谢！
请看附件。

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

[求助] ADO导入数据遇到极大困难！