问个连接数据问题，求解答

∽輝Ⅱ∝

Sub Sheet1统计()
Dim table As String
Dim floder As String
table = "Sheet1统计"
floder = "烧水器"
Dim cnnExternal As ADODB.Connection
Dim rsExternal As ADODB.Recordset
Set cnnExternal = CreateObject("ADODB.Connection")
Set rsExternal = CreateObject("ADODB.Recordset")
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set fs = CreateObject("scripting.filesystemobject")
Set fd = fs.GetFolder(ThisWorkbook.Path & "\" & floder)
cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
For Each f In fd.Files
    pn = Left(f.Name, Len(f.Name) - 4)
    cnnExternal.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & fd & "\" & f.Name
    Sql = "select 注册号,count(注册号)as 数量 from [任意部件信息查询$] where 注册号<>'' and 最后一次操作='I' group by 注册号"
    rsExternal.Open Sql, cnnExternal, adOpenKeyset, adLockOptimistic
    While (rsExternal.EOF = False)
    Sql = "select * from [" & table & "$] where id='" & rsExternal.Fields("注册号") & "'"
    rs.Open Sql, cnn, adOpenKeyset, adLockOptimistic
    rs.Close
   
   
    rsExternal.MoveNext
    Wend
    rsExternal.Close
    cnnExternal.Close
Next
cnn.Close
Set fd = Nothing
Set fs = Nothing
Set rsExternal = Nothing
Set rs = Nothing
Set cnnExternal = Nothing
Set cnn = Nothing

'数值文本变为数值
With Sheets("Sheet1统计").Range("a1").CurrentRegion
    .Value = .Value
End With
MsgBox "数据已成功统计"
Exit Sub
Err_Handle:
    MsgBox Err.Description
End Sub