一段多个access表汇总的简单样例 （备忘 根据情况修改相应代码可实现excel多表入access汇总）

Sub AccessTableTotal()

Dim Conn As New ADODB.Connection
Dim Rec As New ADODB.Recordset
Dim rsTemp As New ADODB.Recordset
Dim strSQL As String

With Conn

.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\TotalData.mdb; "               '改成自己的mdb路径和名称
.Open

End With

strSQL = "select * from 汇总表"
Rec.Open strSQL, Conn, adOpenKeyset, adLockPessimistic

If Rec.RecordCount > 0 Then

Conn.Execute "Delete * from 汇总表"

End If

Set Rec = Nothing

'判断有几张数据表
Set rsTemp = Conn.OpenSchema(adSchemaTables)

Do While Not rsTemp.EOF

Debug.Print rsTemp!TABLE_NAME

If Left(rsTemp!TABLE_NAME, 1) <> "~" And Left(rsTemp!TABLE_NAME, 4) <> "MSys" And rsTemp!TABLE_NAME <> "汇总表" Then

strSQL = "Insert into 汇总表 select * from " & rsTemp!TABLE_NAME
Conn.Execute strSQL
strSQL = "UPDATE 汇总表 SET 汇总表.tablename = " & "'" & rsTemp!TABLE_NAME & "'" & " Where 汇总表.tablename is null "
Conn.Execute strSQL
rsTemp.MoveNext

Else

rsTemp.MoveNext

End If

Loop

strSQL = "Delete * from 汇总表 where ttl=0 "
Conn.Execute strSQL

Set rsTemp = Nothing
Set Rec = Nothing
Set Conn = Nothing

End Sub