Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Importing Transfers - Handle Error and go on to the Next One 1

Status
Not open for further replies.

JoeAtWork

Programmer
Jul 31, 2005
2,285
CA
Sage Accpac 500 ERP (Version 5.5A)

I have a macro that is used to import IC Transfers. If the data I give it is valid, everything is fine.

It will loop through multiple transfers, importing each in turn. I would like that if an error occurs for one of the transfers, it just logs the error, then moves on to the next one. What do I need to do to cancel an insert I started on a view?

For a specific example, if I start creating a transfer and I set the "UNIT" to something that doesn't exist, the first time the error handler catches it OK and the "Resume NextTransfer" sends it to the bottom of the loop to start importing the next Transfer. If that one also has an invalid unit, then the error does not get caught in the local error handler, instead I get kicked out of that subroutine and I get the error "Method 'Value' of object 'IAccpacViewField' failed".

I'm sure there's a couple of lines of codes that would clear the views to get ready to start adding the next transfer, I just haven't figured out what they are.

This is my code:
Code:
Private Function ImportToAccPac_Transfers(DefaultLocation As String) As Boolean

    On Error GoTo ACCPACErrorHandler
    
    Dim Transfer As clsTransaction
    Dim bolInLoop As Boolean
    Dim mDBLinkCmpRW As AccpacCOMAPI.AccpacDBLink
    Set mDBLinkCmpRW = OpenDBLink(DBLINK_COMPANY, DBLINK_FLG_READWRITE)
    
    Dim temp As Boolean
    Dim vwHeader As AccpacCOMAPI.AccpacView
    Dim vwHeaderFields As AccpacCOMAPI.AccpacViewFields
    mDBLinkCmpRW.OpenView "IC0740", vwHeader
    Set vwHeaderFields = vwHeader.Fields
    
    Dim vwDetail As AccpacCOMAPI.AccpacView
    Dim vwDetailFields As AccpacCOMAPI.AccpacViewFields
    mDBLinkCmpRW.OpenView "IC0730", vwDetail
    Set vwDetailFields = vwDetail.Fields
    
    Dim ICTRE1detail2 As AccpacCOMAPI.AccpacView
    Dim ICTRE1detail2Fields As AccpacCOMAPI.AccpacViewFields
    mDBLinkCmpRW.OpenView "IC0741", ICTRE1detail2
    Set ICTRE1detail2Fields = ICTRE1detail2.Fields
    
    Dim ICTRE1detail3 As AccpacCOMAPI.AccpacView
    Dim ICTRE1detail3Fields As AccpacCOMAPI.AccpacViewFields
    mDBLinkCmpRW.OpenView "IC0735", ICTRE1detail3
    Set ICTRE1detail3Fields = ICTRE1detail3.Fields
    
1000    vwHeader.Compose Array(vwDetail, ICTRE1detail2)
    
1100    vwDetail.Compose Array(vwHeader, Nothing, Nothing, Nothing, Nothing, Nothing, ICTRE1detail3)
    
1200    ICTRE1detail2.Compose Array(vwHeader)
    
1300    ICTRE1detail3.Compose Array(vwDetail)

1400    For Each Transfer In m_colTransfers
1450        bolInLoop = True
1500        vwHeader.Init
1600        vwHeaderFields("HDRDESC").PutWithoutVerification (Transfer.UserID)   ' Description
1700        vwHeaderFields("TRANSDATE").Value = Transfer.TransDate
1800        vwDetail.RecordCreate 0
1900        vwDetailFields("ITEMNO").Value = Transfer.ItemID
            'Get an error if Quantity set to 0, so convert to absolute value
2100        vwDetailFields("QTYREQ").Value = Abs(CDbl(Transfer.Quantity))                     ' Quantity
2200        vwDetailFields("UNIT").Value = Transfer.UOM                           ' Unit of Measure

            'If Quantity is positive, TOLOC=”data from file” and FROMLOC=DefaultLocation,
            'otherwise the opposite if Quantity is negative
2210        If CDbl(Transfer.Quantity) > 0 Then
2220            vwDetailFields("TOLOC").Value = Transfer.LocationID
2230            vwDetailFields("FROMLOC").Value = DefaultLocation
2240        Else
2250            vwDetailFields("FROMLOC").Value = Transfer.LocationID
2260            vwDetailFields("TOLOC").Value = DefaultLocation
2270        End If
2300        vwDetail.Insert
2400        vwHeader.Insert
        
2500        m_lngAddedTransfers = m_lngAddedTransfers + 1

NextTransfer:
2550        On Error GoTo ACCPACErrorHandler

2600    Next
    
2650    bolInLoop = False

2700    ImportToAccPac_Transfers = True
    
ExitFunction:
2800    Exit Function

ACCPACErrorHandler:
    Dim strError As String
    Dim lCount As Long
    Dim lIndex As Long
    Dim lErrNo As Long
    Dim strDetail As String
    
    If Not (Transfer Is Nothing) Then
        strDetail = "ItemID=" & Transfer.ItemID & ";TransDate=" & Transfer.TransDate & ";UserID=" & Transfer.UserID & _
         ";Quantity=" & Transfer.Quantity & ";UOM=" & Transfer.UOM & ";Location=" & Transfer.LocationID
    Else
        strDetail = ""
    End If
    

    If Errors Is Nothing Then
        strError = "Error # " & Err.Number & ": " & Err.Description

        If Erl <> 0 Then
            strError = strError & " LINE " & Erl
        End If

         WriteToLog Now, "FAIL", "Import Transfer", strError, strDetail
    Else
        lCount = Errors.Count

        If lCount = 0 Then
            strError = "Error # " & Err.Number & ": " & Err.Description

            If Erl <> 0 Then
                strError = strError & " LINE " & Erl
            End If

            WriteToLog Now, "FAIL", "Import Transfer", strError, strDetail
            
        Else
            strError = "AccPac errors:"

            lErrNo = 0
            For lIndex = 0 To lCount - 1
                lErrNo = lErrNo + 1
                strError = strError & " " & lErrNo & ". " & Errors.Item(lIndex) & ";"
            Next

            If Erl <> 0 Then
                strError = strError & " LINE " & Erl
            End If

            WriteToLog Now, "FAIL", "Import Transfer", strError, strDetail

            Errors.Clear
        End If

    End If

    m_lngErrorsTransfers = m_lngErrorsTransfers + 1

    If bolInLoop Then
        GoTo NextTransfer
    Else
        GoTo ExitFunction
    End If
End Function
 
Damn, don't I feel dumb.

Problem solved - star for Tuba.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top