VB在导入Excel表到access的时候，只能导入部分数据（付源代码） 请老师指点

Private Sub 收入_Click()
Dim strFieldsName As String
Dim strValue As String
Dim strSQL As String
Dim cnnADO As New ADODB.Connection

Dim fileadd As String
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object

Dim r As Long

cnnADO.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=6109003091;Data Source=" + App.Path + "\四知.mdb;Persist Security Info=False"
   
cnnADO.Open
CommonDialog1.ShowOpen
CommonDialog1.Filter = "" '选择你要的文件
fileadd = CommonDialog1.FileName
If fileadd = "" Then Exit Sub
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.Workbooks.Open(fileadd) '打开已经存在的EXCEL工件簿文件
xlApp.Visible = False ' =  True '设置EXCEL对象可见（或不可见）
Set xlSheet = xlBook.Worksheets(1) '设置活动工作表

r = 1
Do While (Trim(xlSheet.cells(r, 1)) <> "") Or (xlSheet.cells(r, 1) <> 0)

strValue = "'" & Trim(xlSheet.cells(r, 1)) & "','" & Trim(xlSheet.cells(r, 2)) _
           & "','" & Trim(xlSheet.cells(r, 3)) & "','" & Trim(xlSheet.cells(r, 4)) _
            & "','" & Trim(xlSheet.cells(r, 5)) & "','" & "Off" & "'"

strSQL = "insert into 支出明细表 ( 档案号 ,姓名 ,支出摘要 ,金额 ,时间 ,结算) values(" _
           & strValue & ")"
cnnADO.Execute strSQL
r = r + 1
Loop
xlApp.DisplayAlerts = False '不进行安全提示 '
Set xlSheet = Nothing '
Set xlBook = Nothing '
xlApp.Quit '
Set xlApp = Nothing
   Set DataGrid1.DataSource = Adodc1
   

 cnnADO.Close

 Set cnnADO = Nothing

 

 End Sub