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

wtqzhjb

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

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

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


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

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

wtqzhjb

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

wtqzhjb

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

zhaogang1960

问题交待的好像不是很清楚，下面代码是第一步，先看看是不是这样？
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

请看附件：
导入数据.rar (37.76 KB, 下载次数: 40)

2011-7-2 14:20 上传

点击文件名下载附件

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

wtqzhjb

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

wtqzhjb

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

wtqzhjb

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

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

wtqzhjb

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

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

如何纠正？
谢谢！

wtqzhjb

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

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