1

フォームに単純なコマンド ボタンがあります。「クリック」イベント プロシージャを使用して、カスタマイズされたプロセスの一部として Excel ファイルをデータベースに 1 行ずつインポートします。私は自分を設定しました：

On Error GoTo DtUplErr

手順の最初に、VBA オプションをチェックして、「ハンドルされていないエラーで中断する」ことを確認しましたが、ハンドル ブックマークに移動せず、代わりに標準のランタイム エラー プロンプトがスローされます。

実際の手順自体は、ワークスペースを使用して更新を実行します (これが問題を引き起こすかどうかは不明です)。

私が壊しているエラーは 3022 (Duplicate Values) です。これは確認してキャプチャするつもりなので、データの問題ではありません。

すべてのオブジェクトをクリーンな mdb にインポートしようとしましたが、まだうまくいきません。本当に混乱しています。

助言がありますか？

完全なコード (量の謝罪)

Private Sub cmdSelect_Click()

'MS Excel
Dim xlApp       As Object 'Late Binding
Dim xlWrkBk     As Object
Dim xlWrkSt     As Object
Dim lngRow      As Long
Dim lngRowCnt   As Long

'Recordsets/Workspace
Dim WkSp        As DAO.Workspace 'Transaction Buffer
Dim rsMs        As DAO.Recordset 'Master
Dim rsSu        As DAO.Recordset 'Supplier
Dim rsAd        As DAO.Recordset 'Address
Dim rsAs        As DAO.Recordset 'Asset

'Misc
Dim strFile     As String
Dim dblMPRN     As Double
Dim lngPerc     As Long

On Error GoTo DtUplErr

Loading 1
strFile = DataUploadDialog
If strFile & "" = "" Then Exit Sub 'Quit if no file selected

'Open up the file
Set xlApp = CreateObject("Excel.Application")
Set xlWrkBk = xlApp.Workbooks.Open(strFile)
Set xlWrkSt = xlWrkBk.Worksheets(1)

Forms!frmUpload!cmdHidden.SetFocus
DoCmd.Hourglass -1

'Validate file format before import
With xlWrkSt
    If .Range("A1") <> "MPRN" _
    Or .Range("B1") <> "Notification" _
    Or .Range("C1") <> "Asset" _
    Or .Range("D1") <> "Reference No." _
    Or .Range("E1") <> "WMS Job No." _
    Or .Range("F1") <> "Meter Worker" _
    Or .Range("G1") <> "Job Status" _
    Or .Range("H1") <> "Date" _
    Or .Range("I1") <> "Time" _
    Or .Range("J1") <> "Sales district" _
    Or .Range("K1") <> "Customer" _
    Or .Range("L1") <> "Location" _
    Or .Range("M1") <> "Additional Info" _
    Or .Range("N1") <> "Street" _
    Or .Range("O1") <> "Dependent Locality" _
    Or .Range("P1") <> "Post Town" _
    Or .Range("Q1") <> "Postal Code" _
    Or .Range("R1") <> "Serial number" _
    Or .Range("S1") <> "Cur. Serial No." _
    Or .Range("T1") <> "Manufacturer Code" _
    Or .Range("U1") <> "Model Code" _
    Or .Range("V1") <> "Year of Manufacture" _
    Then
        xlWrkBk.Close
        xlApp.Quit
        Set xlApp = Nothing
        Set xlWrkBk = Nothing
        Set xlWrkSt = Nothing

        DoCmd.Hourglass 0

        MsgBox "Selected file is not in the correct format, please ensure " & _
               "the original column headers have not been moved/renamed" & _
               vbCr & vbCr & _
               "For further assistance please contact app support", 48
        Exit Sub
    End If
End With

Forms!frmUpload!cmdSelect.Enabled = 0
Forms!frmUpload!cmdClose.Enabled = 0

'Get total number of rows in file
lngRow = 1

Do Until xlWrkSt.Cells(lngRow, 1).Value & "" = ""
    lngRow = lngRow + 1
Loop

lngRowCnt = lngRow - 2

'Start writing to the tables
Set WkSp = DBEngine.Workspaces(0)

WkSp.BeginTrans

    Set rsMs = CurrentDb.OpenRecordset("tblMaster", dbOpenDynaset)
    Set rsSu = CurrentDb.OpenRecordset("tblSupplierHist", dbOpenDynaset)
    Set rsAd = CurrentDb.OpenRecordset("tblAddress", dbOpenDynaset)
    Set rsAs = CurrentDb.OpenRecordset("tblAssetHist", dbOpenDynaset)

    lngRow = 2

    Do Until lngRow > lngRowCnt + 1

ProcessUpload:
        With xlWrkSt

            dblMPRN = .Range("A" & lngRow) 'Store MPRN for additional tables

            'Master
            rsMs.AddNew
                rsMs!MPRN = dblMPRN
                rsMs!LoadTimestamp = Now()
                rsMs!Notification = .Range("B" & lngRow)
                rsMs!Asset = .Range("C" & lngRow)
                rsMs!JobRef = .Range("D" & lngRow)
                rsMs!WmsJobRef = .Range("E" & lngRow)
                rsMs!MeterWorker = .Range("F" & lngRow)
                rsMs!JobStatus = .Range("G" & lngRow)
                rsMs!JobTimestamp = .Range("H" & lngRow) & " " & .Range("I" & lngRow)
                rsMs!SalesDistrict = .Range("J" & lngRow)
                rsMs!AddInfo = .Range("M" & lngRow)
            rsMs.Update

            'Supplier
            rsSu.AddNew
                rsSu!MPRN = dblMPRN
                rsSu!SupplierID = .Range("K" & lngRow)
                rsSu!Timestamp = Now()
                rsSu!Advisor = "System"
            rsSu.Update

            'Address
            rsAd.AddNew
                rsAd!MPRN = dblMPRN
                rsAd!Street = .Range("N" & lngRow)
                rsAd!Locality = .Range("O" & lngRow)
                rsAd!Town = .Range("P" & lngRow)
                rsAd!PostCode = .Range("Q" & lngRow)
            rsAd.Update

            'Asset
            rsAs.AddNew
                rsAs!MPRN = dblMPRN
                rsAs!SN = .Range("R" & lngRow)
                rsAs!Make = .Range("T" & lngRow)
                rsAs!Model = .Range("U" & lngRow)
                rsAs!YOM = .Range("V" & lngRow)
                rsAs!Location = .Range("L" & lngRow)
                rsAs!Timestamp = Now()
                rsAs!Advisor = "System"
            rsAs.Update

            'Work out progress
            lngPerc = Round((lngRow / lngRowCnt) * 100)
            lngPerc = IIf(lngPerc > 0, lngPerc - 1, lngPerc)

            Forms!frmUpload!txtPerc = lngPerc & "/" & lngRowCnt & "  (" & lngPerc & " %)"
            Forms!frmUpload!ProgBar.Value = lngPerc

            'Let the display catch up
            DoEvents
            Sleep 100

            lngRow = lngRow + 1 'Advance

        End With

    Loop

WkSp.CommitTrans

Forms!frmUpload!txtPerc = lngRowCnt & "/" & lngRowCnt & "  (100 %)"
Forms!frmUpload!ProgBar.Value = 100
DoEvents

'Cleanup
xlWrkBk.Close
xlApp.Quit
Set xlApp = Nothing
Set xlWrkBk = Nothing
Set xlWrkSt = Nothing

rsMs.Close
rsSu.Close
rsAd.Close
rsAs.Close
WkSp.Close
Set rsMs = Nothing
Set rsSu = Nothing
Set rsAd = Nothing
Set rsAs = Nothing
Set WkSp = Nothing

Forms!frmUpload!cmdClose.Enabled = -1

DoCmd.Hourglass 0

Exit Sub

DtUplErr:
Select Case Err

    Case 3022 'Index Violation (Assumed PK MPRN in tblMaster)
        lngRow = lngRow + 1
        GoTo ProcessUpload

    Case Else 'Cleanup and then show error
        WkSp.Rollback 'Cancel transaction so data not affected

        xlWrkBk.Close
        xlApp.Quit
        Set xlApp = Nothing
        Set xlWrkBk = Nothing
        Set xlWrkSt = Nothing

        rsMs.Close
        rsSu.Close
        rsAd.Close
        rsAs.Close
        WkSp.Close
        Set rsMs = Nothing
        Set rsSu = Nothing
        Set rsAd = Nothing
        Set rsAs = Nothing
        Set WkSp = Nothing

        Forms!frmUpload!cmdSelect.Enabled = -1
        Forms!frmUpload!cmdClose.Enabled = -1

        DoCmd.Hourglass 0

        ShowError Err, "ModFunctions", "DataUpload", Err.Description

End Select

End Sub
4

3 に答える 3

1

将来のトラブルシューティングを容易にするためにコードを単純化するために、私はこの提案を提供します。

セクションをから'Cleanupに変更Exit Subします。

MySubShallHaveOnlyOneExitPoint:
    xlWrkBk.Close
    xlApp.Quit
    Set xlApp = Nothing
    Set xlWrkBk = Nothing
    Set xlWrkSt = Nothing
    rsMs.Close
    rsSu.Close
    rsAd.Close
    rsAs.Close
    WkSp.Close
    Set rsMs = Nothing
    Set rsSu = Nothing
    Set rsAd = Nothing
    Set rsAs = Nothing
    Set WkSp = Nothing
    Forms!frmUpload!cmdClose.Enabled = -1
    DoCmd.Hourglass 0
    Exit Sub

次に、Case Elseエラーハンドラのを次のように簡略化できます。

Case Else ' Cleanup and then show error '
    WkSp.Rollback ' Cancel transaction so data not affected '
    Forms!frmUpload!cmdSelect.Enabled = -1
    ShowError Err, "ModFunctions", "DataUpload", Err.Description
    Resume MySubShallHaveOnlyOneExitPoint
于 2012-07-26T16:15:48.867 に答える
1

@HansUp からの提案のおかげで、エラーの根本を止めようとしてコードをステップ実行しましたが、予想どおり、それは最も単純な (まだ最も腹立たしい) ものです。

最初のエラーで、私のコードは意図したとおりにこの時点まで実行されます。

DtUplErr:
    Select Case Err

    Case 3022 'Index Violation (Assumed PK MPRN in tblMaster)
        lngRow = lngRow + 1
        GoTo ProcessUpload

次に、次の項目と残りのプロセスに戻りますが、次のエラーで失敗し、事実上すべてが 1 つの「単語」になるため、次の行を変更しました。

Goto ProcessUpload

に：

Resume ProcessUpload

現在、エラーは引き続き処理されています。ふう、「GoTo」よりも「Resume」キーワードの方が適切な理由があることは常に知っていましたが、今までは間違ったという悲惨さを感じていませんでした ^_^

于 2012-07-26T14:54:47.180 に答える
0

編集: Err オブジェクトのデフォルトで返される 'Number' プロパティ。

問題はあなたの発言にあると思いますSelect Case。エラーオブジェクトの「Number」プロパティがありません。Select Caseブロック全体をスキップするだけです

DtUplErr:
Select Case Err.Number 'Use the Error Number for your Select Case Statement

    Case 3022 'Index Violation (Assumed PK MPRN in tblMaster)
        lngRow = lngRow + 1
        Err.Clear
        On Error Goto DtUplErr 'might need to tell it to branch on error again, i havn't tested
        GoTo ProcessUpload

    Case Else 'Cleanup and then show error
        MsgBox Err.Description
        'do whatever here
End Select

于 2012-07-26T14:13:54.353 に答える