以下是引用yuxia0528在2008-3-5 14:16:08的发言：查询－在设计试图中创建查询， 显示表中添加“BBBB2008.MDB”，然后“关闭”， “查询－追加查询”，在“追加到”表名称中选“AAAA2008.MDB”。“确定”，最后“运行”即可。 同样的，再把CCCC2008.MDB追加到AAAA2008.MDB中。
>> 加入VBA的这个部分 Option Compare Database
'--------Module--Collect--------------
'
' collect all DATA into ONE
'
'-------------------------------------
Function CollectAll()
Dim CurDB As Database
Dim strCurDBName, strCurPath, strMDBFile As String
Dim strSrcTAB, strDstTAB As String
Dim strSQL, strSQLTMP As String
On Error Resume Next '-------------------
'----Default Setting
'-------------------
Let strPath = "C:\TEMP\" Set CurDB = CurrentDb Let strCurDBName = Trim(Mid(CurDB.Name, InStrRev(CurDB.Name, "\") + 1, 100)) Let strSrcTAB = "OLD_ABCD" Let strDstTAB = "NEW_ABCD" Let strSQL = "INSERT INTO [@DSTTAB] SELECT t1.* FROM [@MDBFILE].[@SRCTAB] AS t1 WHERE 1=1 "
'-------------------
'----Search *.MDB
'-------------------
strMDBFile = Dir(strPath & "*.mdb", vbNormal)
While strMDBFile <> ""
If (strMDBFile <> strCurDBName) Then
Let strSQLTMP = Replace(strSQL, "@DSTTAB", strDstTAB)
Let strSQLTMP = Replace(strSQLTMP, "@MDBFILE", strPath & strMDBFile)
Let strSQLTMP = Replace(strSQLTMP, "@SRCTAB", strSrcTAB)
'-------------------
'----Import Into
'-------------------
Err.Clear
'CurDB.Execute strSQLTMP
CurDB.Execute strSQLTMP
If (Err.Number > 0) Then
MsgBox strPath & strMDBFile & " : " & Err.Description, vbOKOnly, "<< Import Status >>"
Else
MsgBox strPath & strMDBFile & " : " & CurDB.RecordsAffected, vbOKOnly, "<< Import Status >>"
End If
End If
strMDBFile = Dir()
Wend
End Function
[em05] | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2008-3-5 10:53
楼主
