我编的合并数据库的程序合并速度太慢了.请求高手帮我改进,我编的原码如下:

hebinhoufilename = InputBox("请输入合并后文件名.", "提示", Year(Date) & Month(Date) & Day(Date) & "合并汇总")

'VB编辑器主窗体的【工程】菜单－>【引用】，在弹出的窗体中选择【Microsoft ADO Ext. 2.X for DDL and Security】，“2.X”表示版本。
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
Dim pstr As String
Dim DB As String
Dim counter
DB = App.Path & "\" & hebinhoufilename & ".mdb"
If Dir(DB) <> "" Then Kill DB'存在则删除便于重新建立.
If Dir(DB) = "" Then
FileCopy List1.List(0), DB'将选中的(选中的要合并的文件都在list里面)其中的一个文件复制到这里,就不用新建数据库存了.

pstr = "Provider=Microsoft.Jet.OLEDB.4.0;" '数据库驱动 4.0 For Office 2k/2003, 3.5.1 For Office 97
pstr = pstr & "Data Source=" & DB

'cat.Create pstr '建立数据库
'cat.ActiveConnection = pstr
'tbl.Name = "defects" '定义表名
'For i = 0 To zhiduangsu - 1 '定义字段
'tbl.Columns.Append Sujuwenjiansuzu(0, i, 0), Sujuwenjiansuzu(0, i, 1) '定义字段
'Next i
'cat.Tables.Append tbl '建立表
'For i = 0 To zhiduangsu - 1 '定义字段
'tbl.Columns(Sujuwenjiansuzu(0, i, 0)).Attributes = adColNullable
'Next i
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
conn.Open pstr
rs.CursorLocation = adUseClient
rs.Open "defects", conn, adOpenKeyset, adLockPessimistic





For I = 1 To WENJIANSU - 1 '文件数'因第一个文件已经复制过来,只要把其它的文件追加到后即可.
Label4.Caption = "正在处理第" & I + 1 & "个文件"
Dim pstr11 As String
Dim DB11 As String

Dim conn11 As New ADODB.Connection
Dim rs11 As New ADODB.Recordset

DB11 = List1.List(I)
pstr11 = "Provider=Microsoft.Jet.OLEDB.4.0;" '数据库驱动 4.0 For Office 2k/2003, 3.5.1 For Office 97
pstr11 = pstr11 & "Data Source=" & DB11


conn11.Open pstr11
rs11.CursorLocation = adUseClient
rs11.Open "defects", conn11, adOpenKeyset, adLockPessimistic
rs11.MoveFirst
K = 0
Do While Not rs11.EOF

rs.AddNew '往表中添加新记录


For j = 0 To zhiduangsu - 1'字段个数
rs.Fields(j).Value = rs11.Fields(j).Value'每个记录的每个字段分开读取后赋值.不知道在这里能否一下读取全部数据一起追加到合并结果文件后???请高手在此步指导.谢谢
Next j
K = K + 1'统计读取了多少记录
Label2.Caption = K
rs.Update
rs11.MoveNext

Loop
conn11.Close
Label3.Caption = "处理完" & I + 1 & "个文件"
Next I



Else

MsgBox "此文件已经存在"
GoTo note
End If


MsgBox "处理完毕"