Share
Report
6,405Using the SL Import Assistant for AP Vouchers. Out of the box, it works great, as long as there are no SL Message Boxes that pop up during the import....
Recently added eBanking to the install, which throws Message 24199 upon VendID entry when the Vendor is a New Pre-Note. Trying to respond "OK" to the message to allow import to continue. Added the necessary "Private WithEvents SIVApp As SIVApplication" to a Class Module, and the following as a Module:
Public Sub SIVApp_Message(ByVal MessageNumber As Long, ByVal MessageText As String, ByVal MessageType As sivMessageType, MessageResponse As sivMessageResponse)
If MessageNumber = 24199 Then
MessageResponse = sivMsgRspOk
Else
MessageResponse = sivMsgRspOk
End If
End Sub
Cannot get the import routine to respond to the message, and mot fail the import. Import module code is below (code where the vendid is set from the Excel data is in Red). Where do I tell the program to not error out if the 24199 message box appears?
Option Explicit
Private Const FirstDataRow As Integer = 14
Private Const FirstPivotDataRow As Integer = 6
Public MyServerName As String
Public MySysDBName As String
Public MyCoID As String
Private MyUserID As String
Private MyPwd As String
Sub ImportVouchers()
Dim sivTB As SIVToolbar
Dim SIVApp As SIVApplication
Dim i As Integer
Dim thisLevel As String
Dim thisField As String
Dim iRow As Integer
Dim iSuccessRow As Integer
Dim iErrorRow As Integer
Dim drow As Integer
Dim trow As Integer
Dim temprow As Integer
Dim CurrVendor As String
Dim docError As Boolean
' Clean up the existing Batch Number
Worksheets("APDocDetail").Cells(7, 3) = ""
' Clean up the Error Region For Batch
Worksheets("APDocDetail").Cells(7, 4) = ""
' Get Next Available Success Row
iSuccessRow = 2
Do While Worksheets("Successful").Cells(iSuccessRow, 1).Value <> ""
iSuccessRow = iSuccessRow + 1
Loop
' Get Next Available Error Row
iErrorRow = 2
Do While Worksheets("Error").Cells(iErrorRow, 1).Value <> ""
iErrorRow = iErrorRow + 1
Loop
On Error Resume Next
Application.StatusBar = "Updating Solomon, please wait."
Set sivTB = New SIVToolbar
MyServerName = Worksheets("Dynamics SL Login Info").Range("B1").Value
MySysDBName = Worksheets("Dynamics SL Login Info").Range("B2").Value
MyCoID = Worksheets("Dynamics SL Login Info").Range("B3").Value
MyUserID = Worksheets("Dynamics SL Login Info").Range("B4").Value
MyPwd = ""
sivTB.Login MyServerName, MySysDBName, MyCoID, MyUserID, MyPwd
If Err.Number <> 0 Then
'Login error encountered
' MsgBox "Login error encountered. Validate your login settings.", vbOKOnly
MsgBox Err.Description, vbOKOnly
Set SIVApp = Nothing
Set sivTB = Nothing
Worksheets("Dynamics SL Login Info").Activate
Cells(1, 1).Select
Exit Sub
End If
Set SIVApp = sivTB.StartApplication("0301000.exe")
If Err.Number <> 0 Then
MsgBox "Voucher Entry cannot be loaded due to error: " & Err.Description, vbOKOnly
Set SIVApp = Nothing
sivTB.Logout
sivTB.Quit
Set sivTB = Nothing
Exit Sub
End If
If Worksheets("Dynamics SL Login Info").Range("B5").Value = True Then
SIVApp.Visible = True
End If
On Error GoTo BATCH_ERROR
' Batch Header Information
thisLevel = "Batch"
thisField = Worksheets("APDocDetail").Cells(10, 1)
SIVApp.Controls("cctrltot") = Worksheets("APDocDetail").Cells(10, 3)
thisField = Worksheets("APDocDetail").Cells(9, 1)
SIVApp.Controls("cbatchandling") = Worksheets("APDocDetail").Cells(9, 3)
thisField = Worksheets("APDocDetail").Cells(8, 1)
SIVApp.Controls("cperpost") = Worksheets("APDocDetail").Cells(8, 3)
drow = FirstPivotDataRow
trow = FirstDataRow
On Error GoTo DOC_ERROR
' For each Vendor/Invoice on APDocSummary, create voucher within batch
Do While Worksheets("APDocSummary").Cells(drow, 1).Value <> "(blank)"
docError = False
If drow <> FirstPivotDataRow Then SIVApp.New "Document"
thisLevel = "Document"
thisField = Worksheets("APDocSummary").Cells(FirstPivotDataRow - 1, 1)
If Worksheets("APDocSummary").Cells(drow, 1).Value = "" Then
temprow = drow
Do
temprow = temprow - 1
If Worksheets("APDocSummary").Cells(temprow, 1).Value <> "" Then Exit Do
Loop While Worksheets("APDocSummary").Cells(temprow, 1).Value = ""
SIVApp.Controls("cvendid") = Worksheets("APDocSummary").Cells(temprow, 1).Value
CurrVendor = Worksheets("APDocSummary").Cells(temprow, 1).Value
Else
SIVApp.Controls("cvendid") = Worksheets("APDocSummary").Cells(drow, 1).Value
CurrVendor = Worksheets("APDocSummary").Cells(drow, 1).Value
End If
If Err.Number <> 0 Then
docError = True
Else
thisField = Worksheets("APDocSummary").Cells(FirstPivotDataRow - 1, 2)
If Trim(Worksheets("APDocDetail").Cells(1, 6)) = "EXPENSES" Then
SIVApp.Controls("cinvcnbr") = Format(Worksheets("APDocSummary").Cells(drow, 2).Value, "mmddyyyy")
Else
SIVApp.Controls("cinvcnbr") = Left(Worksheets("APDocSummary").Cells(drow, 2).Value, 15)
End If
thisField = Worksheets("APDocSummary").Cells(FirstPivotDataRow - 1, 3)
SIVApp.Controls("cinvcdate") = Format(Worksheets("APDocSummary").Cells(drow, 3).Value, "mm/dd/yyyy")
thisField = Worksheets("APDocSummary").Cells(FirstPivotDataRow - 1, 4)
SIVApp.Controls("corigdocamt") = Worksheets("APDocSummary").Cells(drow, 4).Value
End If
thisLevel = "Transaction"
Do While Worksheets("APDocDetail").Cells(trow, 1).Value <> ""
If (CurrVendor = Worksheets("APDocDetail").Cells(trow, 1)) And Worksheets("APDocSummary").Cells(drow, 2).Value = Worksheets("APDocDetail").Cells(trow, 2).Value Then
If Not docError Then
SIVApp.Next "Transaction"
thisField = Worksheets("APDocDetail").Cells(FirstDataRow - 1, 4)
SIVApp.Controls("cacct") = Worksheets("APDocDetail").Cells(trow, 4)
thisField = Worksheets("APDocDetail").Cells(FirstDataRow - 1, 5)
SIVApp.Controls("csub") = Worksheets("APDocDetail").Cells(trow, 5)
thisField = Worksheets("APDocDetail").Cells(FirstDataRow - 1, 6)
SIVApp.Controls("ctranamt") = Worksheets("APDocDetail").Cells(trow, 6)
thisField = Worksheets("APDocDetail").Cells(FirstDataRow - 1, 7)
SIVApp.Controls("ctrandesc") = Left(Worksheets("APDocDetail").Cells(trow, 7), 30)
SIVApp.Save
End If
If Err.Number <> 0 Then
Worksheets("APDocDetail").Cells(trow, 8) = "Error"
Worksheets("APDocDetail").Cells(trow, 9) = Err.Description
Else
Worksheets("APDocDetail").Cells(trow, 8) = "Success"
Worksheets("APDocDetail").Cells(trow, 10) = SIVApp.Controls("crefnbrh")
End If
Err.Clear
End If
'sivApp.Next "Transaction"
trow = trow + 1
If Worksheets("APDocDetail").Cells(trow, 1) = "" Then Exit Do
Loop
ERROR_RESUME_DOC:
Err.Clear
trow = FirstDataRow
drow = drow + 1
If Worksheets("APDocSummary").Cells(drow, 1) = "Grand Total" Then Exit Do
Loop
On Error Resume Next
Worksheets("APDocDetail").Cells(7, 3) = SIVApp.Controls("cbatnbrb")
' Pop Off Errors and Successes
Do While Worksheets("APDocDetail").Cells(trow, 1).Value <> ""
If Worksheets("APDocDetail").Cells(trow, 8) = "Success" Then
Worksheets("APDocDetail").Cells(trow, 9) = SIVApp.Controls("cbatnbrb")
Worksheets("APDocDetail").Rows(trow).Copy Destination:=Worksheets("Successful").Rows(iSuccessRow)
iSuccessRow = iSuccessRow + 1
ElseIf Worksheets("APDocDetail").Cells(trow, 8) = "Error" Then
Worksheets("APDocDetail").Rows(trow).Copy Destination:=Worksheets("Error").Rows(iErrorRow)
iErrorRow = iErrorRow + 1
End If
Worksheets("APDocDetail").Range(Cells(trow, 1), Cells(trow, 10)).Clear
trow = trow + 1
Loop
' Save and close
'sivApp.Save
' If Batch Info doesn't go in then we just drop off
ERROR_RESUME_BATCH:
SIVApp.Quit
SIVApp.Dispose
Set SIVApp = Nothing
'Close the Toolbar
sivTB.Logout
sivTB.Quit
sivTB.Dispose
Set sivTB = Nothing
Application.StatusBar = ""
Exit Sub
DOC_ERROR:
If Err.Number <> 0 Or Err.Number <> 24199 Then
Worksheets("APDocDetail").Cells(trow, 8) = "Error"
Worksheets("APDocDetail").Cells(trow, 9) = "Level: " & thisLevel & " Field: " & thisField & " => " & Err.Description
Resume ERROR_RESUME_DOC
End If
BATCH_ERROR:
If Err.Number <> 0 Then
Worksheets("APDocDetail").Cells(7, 4) = "Batch Error Field: " & thisField & " => " & Err.Description
SIVApp.Cancel
Resume ERROR_RESUME_BATCH
End If
End Sub
*This post is locked for comments
All responses (
Answers (
