Excel数据导入Access，导入不完全

If fso.FileExists(DataBase_Name_Connect_Info) = True Then

'基本信息数据库

l = 0

Set WIS_Conn = New ADODB.Connection

WIS_Conn.Open "provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DataBase_Name_Connect_Info & ";Persist Security Info=false"

Set WIS_Rs = WIS_Conn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, Empty))

ReDim tem_Arr(100)

Do Until WIS_Rs.EOF

If Left(WIS_Rs!table_name, 4) <> "MSys" Then

tem_Arr(l) = WIS_Rs!table_name

l = l + 1

End If

WIS_Rs.MoveNext

DoEvents

Loop

'MsgBox l

e = 0

frm_DB_CreateFile.txt_BS.Text = Format(Time, "hh:mm:ss") & " 获取Con数据库名称集合: " & l & vbCrLf & frm_DB_CreateFile.txt_BS.Text 'DataBase_Name_Connect_Info

DoEvents

'Call Close_DB

'    If WIS_Rs.State = adStateOpen Then WIS_Rs.Close

'        Set WIS_Rs = Nothing

'    If WIS_Conn.State = adStateOpen Then WIS_Conn.Close

'        Set WIS_Conn = Nothing

For k = 0 To l - 1 'DB_Table 名称集合

If l = 0 Then

Exit For

End If

If Judge_Arr(Arr_Sheet(), tem_Arr(k)) = True Then   '判断该表是否存在 Excel Sheet中

Excel_Search_TxT = "select * from [" & tem_Arr(k) & "$]"    'Excel

Set Excel_Rs = Excel_Connect(Excel_Search_TxT, str_Excel_Addr)

Int_Excel_Count = Excel_Rs.RecordCount  '表示Excel 数据个数

'            DoEvents

'lab_Progree  & Arr_Sheet_DB_Count(k)

frm_DB_CreateFile.txt_BS.Text = Format(Time, "hh:mm:ss") & " 载入Con数据: " & tem_Arr(k) & " Count:" & " @:" & Int_Excel_Count & vbCrLf & frm_DB_CreateFile.txt_BS.Text        'DataBase_Name_Connect_Info

'            If tem_Arr(k) = "Case_Notice" Then

'                MsgBox 4

'            End If

tem_DB_Count = 0

If Int_Excel_Count <> 0 Then

w = 0

'If str_Update_Mode = "N" Then '表示采用的全新数据，将删除 数据库里面的数据

'                DB_Delete_TxT = "Delete * from " & tem_Arr(k) 'Access

'                str_access_sql = str_DB_Provider & DataBase_Name_Connect_Info & ";Jet OLEDB:Database Password=" & WIS_DB_PD '包含有密码

'                'WIS_Conn.Open str_access_sql

'                WIS_Conn.Execute DB_Delete_TxT

DoEvents

DB_Search_TxT = "Select * from " & tem_Arr(k) 'Access '表示仅仅增加新的数据 不删除旧数据