Question

我正在尝试将电子表格中的信息粘贴到Access数据库中的表单中，但我在Do Until IsEmpty(wks.Cells(i, 1))行收到错误。我正在使用Access 2010。

Option Compare Database

Private Sub Cmd_Mass_Upload_Click()

If MsgBox("ARE YOU SURE YOU WANT TO UPDATE RECORDS?", vbOKCancel, "CONFIRM MASS UPDATE") = vbOK Then
    Dim wks
    Dim db As Database
    Dim rsCheckDuplicate As Recordset
    Dim rsUpdateCC As Recordset
    Dim strSQLCheckDuplicate As String
    Dim strUpdateCC As String
    Dim succesfullyUpdated As Integer
    succesfullyUpdated = 0

    i = 1

    'If Me.Ctl2003 = True Then
        Set wks = Me.upLoadSpreadsheet2010
    'End If

    'If Me.Ctl2010 = True Then
    '    Set wks = Me.upLoadSpreadsheet2010
    'End If

    Do Until IsEmpty(wks.Cells(i, 1))

        i = i + 1
    Loop

    Set db = CurrentDb

    If i > 1 Then

        For j = 1 To i - 1
            strSQLCheckDuplicate = "SELECT TBL_OPEN_VOUCHERS.[VOUCHER NUMBER], TBL_OPEN_VOUCHERS.[INVOICE NUMBER] " & _
                                "FROM TBL_OPEN_VOUCHERS " & _
                                "WHERE (((TBL_OPEN_VOUCHERS.[VOUCHER NUMBER])='" & wks.Cells(j, 1) & "') AND ((TBL_OPEN_VOUCHERS.[INVOICE NUMBER])='" & wks.Cells(j, 2) & "'));"
                                '"WHERE (((TBL_OPEN_VOUCHERS.[VOUCHER NUMBER])='" & wks.Cells(j, 1) & "'));"


            Set rsCheckDuplicate = db.OpenRecordset(strSQLCheckDuplicate)

            If rsCheckDuplicate.EOF Then
                MsgBox "Voucher number " & wks.Cells(j, 1) & " not available in local system!"
            Else
                rsCheckDuplicate.MoveLast
                rsCheckDuplicate.MoveFirst

                If rsCheckDuplicate.RecordCount > 1 Then
                    MsgBox "Voucher number " & wks.Cells(j, 1) & " has multiple entries in local system! Please update manually!"
                End If
                    If Len(wks.Cells(j, 3)) = 6 Then
                        strUpdateCC = "UPDATE TBL_OPEN_VOUCHERS SET TBL_OPEN_VOUCHERS.[CHARGE TO] = '" & wks.Cells(j, 3) & "', TBL_OPEN_VOUCHERS.COMMENTS_NOTES = '" & Form_FRM_MAIN.USER.Caption & ": PART OF MASS UPLOAD ON " & Now() & "' " & _
                                    "WHERE (((TBL_OPEN_VOUCHERS.[VOUCHER NUMBER])='" & wks.Cells(j, 1) & "') AND ((TBL_OPEN_VOUCHERS.[INVOICE NUMBER])='" & wks.Cells(j, 2) & "'));"
                                    '"WHERE (((TBL_OPEN_VOUCHERS.[VOUCHER NUMBER])='" & wks.Cells(j, 1) & "'));"
                        DoCmd.RunSQL strUpdateCC
                        succesfullyUpdated = succesfullyUpdated + 1
                    Else
                        MsgBox "Please check Cost Center"
                    End If
            End If
        Next

    End If
    Set wks = Nothing

    MsgBox "Successfully uploaded " & succesfullyUpdated & " of " & i - 1 & " records!"
End If

End Sub
Private Sub Command7_Click()
On Error GoTo Err_Command7_Click


    DoCmd.Close

Exit_Command7_Click:
    Exit Sub

Err_Command7_Click:
    MsgBox Err.Description
    Resume Exit_Command7_Click

End Sub



Private Sub Ctl2003_Click()
    If Me.Ctl2003 = False Then Me.Ctl2010 = True
    If Me.Ctl2003 = True Then Me.Ctl2010 = False
End Sub

Private Sub Ctl2010_Click()
If Me.Ctl2010 = True Then Me.Ctl2003 = False
If Me.Ctl2010 = False Then Me.Ctl2003 = True
End Sub

Answer 1

您收到的实际错误消息是什么？

您是否尝试过创建与电子表格的连接作为链接表格，然后将电子表格视为表格？

您的代码没有指定＆＃34; wks＆＃34;的数据类型。对象，所以代码不知道它是电子表格。

以下是我使用的方法：

将电子表格链接为链接表（外部数据，导入Excel电子表格，链接到数据源。）这将创建一个＆＃34;表＆＃34;在访问中链接到指定位置的电子表格。
使用查询来识别链接表中但不在本地表中的记录（从upLoadSpreadsheet2010的左外连接tbl_open_vouchers v中选择s。* s.somekeycolumnidontknowthenameof = v。[凭证编号]和s.someotherkeycolumn = v。[发票编号]其中v。[凭证编号]为空）
在你的代码中打开查询，遍历它，做你的事情，或者更好的是仍然创建一个Append查询来为你完成工作而不需要任何代码。

唯一的挑战是确保excel电子表格在正确的时间出现在正确的位置。新的电子表格？只需将其放在与最后一个电子表格相同的位置，然后再次运行该过程。

运行时错误438：（wks.cells（i，1））

1 个答案: