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!

PO Receipts with Automation Error 5.5A

Status
Not open for further replies.

ajwonder

Programmer
Aug 23, 2011
35
ZA
Hi Everyone,

I'm trying to post PO Receipts from MS Access. I've created the macro and modified the code to suit my application, but receive an AUTOMATION ERROR. UNSPECIFIED ERROR the minute I access the detail. I am also trying to be "clever" and print the report in the same go, but receive an error SESSION NOT OPEN, even if I include the same method to open the module at the beginning, infront of the print/preview portion. (I know that there might be garbage, but I'm not to sure what exactly is considered as garbage code)

Thanks in advance!

CODE:

Option Compare Database
Option Explicit
Public Function Receipt()
Dim MyDb As Database, MySet As Recordset, MySql As String, MyDocNum As String, MyCnt As Integer, MySeq, MyRef As String



MySql = "select * from dbo_DelNotes where dbo_DelNotes.PROCESSED = 0"
MyCnt = DCount("PONUMBER", "dbo_DelNotes", "PROCESSED = 0")
If MyCnt = 0 Then Exit Function

Set MyDb = CurrentDb
Set MySet = MyDb.OpenRecordset(MySql, dbOpenDynaset, dbSeeChanges)

On Error GoTo ACCPACErrorHandler

OpenMyModule "PO", "PO1310" 'Re-direct to Custom module
'USE: "??", "??xxxx"
'?? = Module abreviation (AP,AR,CB,IC,OE,PO etc.)
'xxxx = Related Module Accpac view
'Ex: OpenMyModule "PO", "PO1310"
On Error GoTo ACCPACErrorHandler


Dim temp As Boolean
Dim PORCP1header As AccpacCOMAPI.AccpacView
Dim PORCP1headerFields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0700", PORCP1header
Set PORCP1headerFields = PORCP1header.Fields

Dim PORCP1detail1 As AccpacCOMAPI.AccpacView
Dim PORCP1detail1Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0710", PORCP1detail1
Set PORCP1detail1Fields = PORCP1detail1.Fields

Dim PORCP1detail2 As AccpacCOMAPI.AccpacView
Dim PORCP1detail2Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0695", PORCP1detail2
Set PORCP1detail2Fields = PORCP1detail2.Fields

Dim PORCP1detail3 As AccpacCOMAPI.AccpacView
Dim PORCP1detail3Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0718", PORCP1detail3
Set PORCP1detail3Fields = PORCP1detail3.Fields

Dim PORCP1detail4 As AccpacCOMAPI.AccpacView
Dim PORCP1detail4Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0714", PORCP1detail4
Set PORCP1detail4Fields = PORCP1detail4.Fields

Dim PORCP1detail5 As AccpacCOMAPI.AccpacView
Dim PORCP1detail5Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0699", PORCP1detail5
Set PORCP1detail5Fields = PORCP1detail5.Fields

Dim PORCP1detail6 As AccpacCOMAPI.AccpacView
Dim PORCP1detail6Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0705", PORCP1detail6
Set PORCP1detail6Fields = PORCP1detail6.Fields

Dim PORCP1detail7 As AccpacCOMAPI.AccpacView
Dim PORCP1detail7Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0703", PORCP1detail7
Set PORCP1detail7Fields = PORCP1detail7.Fields

Dim PORCP1detail8 As AccpacCOMAPI.AccpacView
Dim PORCP1detail8Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0696", PORCP1detail8
Set PORCP1detail8Fields = PORCP1detail8.Fields

Dim PORCP1detail9 As AccpacCOMAPI.AccpacView
Dim PORCP1detail9Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0717", PORCP1detail9
Set PORCP1detail9Fields = PORCP1detail9.Fields

Dim PORCP1detail10 As AccpacCOMAPI.AccpacView
Dim PORCP1detail10Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0721", PORCP1detail10
Set PORCP1detail10Fields = PORCP1detail10.Fields

Dim PORCP1detail11 As AccpacCOMAPI.AccpacView
Dim PORCP1detail11Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0719", PORCP1detail11
Set PORCP1detail11Fields = PORCP1detail11.Fields

Dim PORCP1detail12 As AccpacCOMAPI.AccpacView
Dim PORCP1detail12Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0697", PORCP1detail12
Set PORCP1detail12Fields = PORCP1detail12.Fields

Dim PORCP1detail13 As AccpacCOMAPI.AccpacView
Dim PORCP1detail13Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0704", PORCP1detail13
Set PORCP1detail13Fields = PORCP1detail13.Fields

PORCP1header.Compose Array(PORCP1detail2, PORCP1detail1, PORCP1detail3, PORCP1detail4, PORCP1detail5, PORCP1detail6, PORCP1detail7, PORCP1detail8)

PORCP1detail1.Compose Array(PORCP1header, PORCP1detail2, PORCP1detail5, Nothing, Nothing, PORCP1detail9)

PORCP1detail2.Compose Array(PORCP1header, PORCP1detail1)

PORCP1detail3.Compose Array(PORCP1header, PORCP1detail4, PORCP1detail5, PORCP1detail10)

PORCP1detail4.Compose Array(PORCP1detail3, PORCP1detail5, PORCP1header, Nothing, Nothing, PORCP1detail11, PORCP1detail8)

PORCP1detail5.Compose Array(PORCP1header, PORCP1detail2, PORCP1detail1, PORCP1detail4, PORCP1detail3, PORCP1detail6, PORCP1detail8)

PORCP1detail6.Compose Array(PORCP1header, PORCP1detail5)

PORCP1detail7.Compose Array(PORCP1header)

PORCP1detail8.Compose Array(PORCP1detail4, PORCP1detail3, PORCP1header, PORCP1detail5, PORCP1detail12)

PORCP1detail9.Compose Array(PORCP1detail1)

PORCP1detail10.Compose Array(PORCP1detail3)

PORCP1detail11.Compose Array(PORCP1detail4)

PORCP1detail12.Compose Array(Nothing, PORCP1detail8, PORCP1detail4)

PORCP1detail13.Compose Array(PORCP1detail8, PORCP1detail1)


MySet.MoveFirst
Do While Not MySet.EOF
PORCP1header.Order = 1
PORCP1header.Order = 0

PORCP1headerFields("RCPHSEQ").PutWithoutVerification ("0") ' Receipt Sequence Key

temp = PORCP1header.Exists
PORCP1header.Init
PORCP1header.Order = 1
temp = PORCP1detail1.Exists
PORCP1detail1.RecordClear
temp = PORCP1detail3.Exists
PORCP1detail3.RecordClear
temp = PORCP1detail4.Exists
PORCP1detail4.RecordClear
temp = PORCP1detail6.Exists
PORCP1detail6.Init
temp = PORCP1detail2.Exists
PORCP1detail2.Init
PORCP1headerFields("VDCODE").Value = MySet!VDCODE ' Vendor

PORCP1headerFields("PROCESSCMD").PutWithoutVerification ("1") ' Command

PORCP1header.Process

PORCP1headerFields("PONUMBER").Value = MySet!PONUMBER ' Purchase Order Number
MySeq = PORCP1headerFields("RCPHSEQ").Value ' Obtain Receipt Sequence Key

PORCP1header.Order = 0
'ERROR 1
PORCP1detail5Fields("LOADPORNUM").Value = MySet!PONUMBER ' Purchase Order Number

PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("4") ' Function
'ERROR 1
PORCP1detail5.Process
PORCP1header.Order = 1
PORCP1detail3Fields("PROCESSCMD").PutWithoutVerification ("1") ' Command
PORCP1detail3.Process
PORCP1headerFields("DATE").Value = MySet!DELDATE ' Receipt Date
PORCP1detail5Fields("FUNCTION").Value = "61" ' Function
PORCP1detail5.Process
PORCP1headerFields("STCODE").Value = MySet!LOCATION ' Ship-To Location

PORCP1headerFields("DESCRIPTIO").Value = "Del. Note: " & MySet!DELNOTENUM & " - Truck Reg.: " & MySet!TRUCKREG ' Description
PORCP1headerFields("REFERENCE").Value = MySet!INTREQNO ' Reference

PORCP1detail1Fields("RCPLREV").PutWithoutVerification ("-1") ' Line Number

PORCP1detail1Fields("RCPLREV").PutWithoutVerification ("-1") ' Line Number

PORCP1detail1.Read
temp = PORCP1detail1.Exists
temp = PORCP1detail1.Exists
'ERROR
PORCP1detail1Fields("LOCATION").Value = MySet!LOCATION ' Location

temp = PORCP1detail1.Exists
'ERROR
PORCP1detail1Fields("RQRECEIVED").Value = MySet!DELQTY ' Quantity Received
If MySet!DELQTY >= PORCP1detail1Fields("OQORDERED").Value Then
PORCP1detail1Fields("POCOMPLETE").Value = "-1" ' Completes PO
ElseIf (MySet!DELQTY - PORCP1detail1Fields("RQRECEIVED").Value) / PORCP1detail1Fields("OQORDERED").Value = 0.02 Then
PORCP1detail1Fields("POCOMPLETE").Value = "-1" ' Completes PO and Cancel Remainder
PORCP1detail1Fields("RQCANCELED").Value = MySet!DELQTY - PORCP1detail1Fields("RQRECEIVED").Value ' Quantity Canceled
Else
PORCP1detail1Fields("POCOMPLETE").Value = "-1" ' Completes PO - NO
End If


temp = PORCP1detail1.Exists
PORCP1detail1.Update

PORCP1detail1Fields("RCPLREV").PutWithoutVerification ("-1") ' Line Number
'ERROR
PORCP1detail1.Read
PORCP1detail3.Browse "(RCPHSEQ = " & MySeq & ")", 1
temp = PORCP1detail3.Exists
PORCP1detail3.RecordClear
PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("10") ' Function
PORCP1detail5.Process
temp = PORCP1header.Exists
PORCP1header.Insert
MyDocNum = PORCP1headerFields("RCPNUMBER").Value ' Read Receipt number
PORCP1detail5Fields("RCPHSEQ").PutWithoutVerification (MySeq) ' Receipt Sequence Key

PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("2") ' Function

'Update processed lines
DoCmd.SetWarnings False
DoCmd.RunSQL "Update dbo_DelNotes SET dbo_DelNotes.PROCESSED = -1, dbo_DelNotes.PROCDATE = #" & Format(Now(), "yyyy/MM/dd HH:mm:ss") & "#, dbo_DelNotes.RCPTNUM ='" & MyDocNum & "' where dbo_DelNotes.UnqID = " & MySet!UnqID
DoCmd.SetWarnings True

PORCP1detail5.Process
Dim POPRNT2 As AccpacCOMAPI.AccpacView
Dim POPRNT2Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0640", POPRNT2
Set POPRNT2Fields = POPRNT2.Fields


Dim rpt As AccpacCOMAPI.AccpacReport
'ERROR AFTER EVERY COMMAND IN THIS SECTION
Set rpt = ReportSelect("PORCP01[PORCP01.RPT]", " ", " ")
Dim rptPrintSetup As AccpacCOMAPI.AccpacPrintSetup
Set rptPrintSetup = GetPrintSetup(" ", " ")
rptPrintSetup.DeviceName = "Feeds_copy&print_general"
rptPrintSetup.OutputName = "10.10.5.233"
rptPrintSetup.Orientation = 1
rptPrintSetup.PaperSize = 1
rptPrintSetup.PaperSource = 15
rpt.PrinterSetup rptPrintSetup
rpt.SetParam "RCPFROM", MyDocNum ' Report parameter: 2
rpt.SetParam "RCPTO", MyDocNum ' Report parameter: 3
rpt.SetParam "PRINTED", "1" ' Report parameter: 4
rpt.SetParam "QTYDEC", "4" ' Report parameter: 5
rpt.NumOfCopies = 1
rpt.Destination = PD_PREVIEW
rpt.PrintDir = ""
rpt.PrintReport
temp = POPRNT2.Exists
POPRNT2.Init

POPRNT2Fields("DOCTYPE").PutWithoutVerification ("3") ' Document Type
POPRNT2Fields("FROMRCP").PutWithoutVerification (MyDocNum) ' From Receipt Number
POPRNT2Fields("TORCP").PutWithoutVerification (MyDocNum) ' To Receipt Number

POPRNT2.Process

temp = PORCP1header.Exists
PORCP1header.Init
PORCP1header.Order = 0

PORCP1headerFields("RCPHSEQ").PutWithoutVerification ("0") ' Receipt Sequence Key

temp = PORCP1header.Exists
PORCP1header.Init
PORCP1header.Order = 1
temp = PORCP1detail1.Exists
PORCP1detail1.RecordClear
temp = PORCP1detail3.Exists
PORCP1detail3.RecordClear
temp = PORCP1detail4.Exists
PORCP1detail4.RecordClear
temp = PORCP1detail6.Exists
PORCP1detail6.Init
temp = PORCP1detail2.Exists
PORCP1detail2.Init

MySet.MoveNext

Loop
MySet.Close

Exit Function

ACCPACErrorHandler:
Dim lCount As Long
Dim lIndex As Long

If Errors Is Nothing Then
MsgBox Err.Description
Else
lCount = Errors.Count

If lCount = 0 Then
MsgBox Err.Description
Else
For lIndex = 0 To lCount - 1
MsgBox Errors.Item(lIndex)
Next
Err.Clear
End If
Resume Next

End If

End Function
 
1. Get rid of every line with "temp" in it.
2. Exactly which line has the error?
 
Thanks for your speedy reply! I've removed the 'temp' lines and added a comment before every line ('******ERROR****). Starts at LOADPORNUM



MySet.MoveFirst
Do While Not MySet.EOF
PORCP1header.Order = 1
PORCP1header.Order = 0

PORCP1headerFields("RCPHSEQ").PutWithoutVerification ("0") ' Receipt Sequence Key

PORCP1header.Init
PORCP1header.Order = 1
PORCP1detail1.RecordClear
PORCP1detail3.RecordClear
PORCP1detail4.RecordClear
PORCP1detail6.Init
PORCP1detail2.Init
PORCP1headerFields("VDCODE").Value = MySet!VDCODE ' Vendor

PORCP1headerFields("PROCESSCMD").PutWithoutVerification ("1") ' Command

PORCP1header.Process

PORCP1headerFields("PONUMBER").Value = MySet!PONUMBER ' Purchase Order Number
MySeq = PORCP1headerFields("RCPHSEQ").Value ' Obtain Receipt Sequence Key

PORCP1header.Order = 0
'******ERROR****
PORCP1detail5Fields("LOADPORNUM").Value = MySet!PONUMBER ' Purchase Order Number

PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("4") ' Function
'******ERROR****
PORCP1detail5.Process
PORCP1header.Order = 1
PORCP1detail3Fields("PROCESSCMD").PutWithoutVerification ("1") ' Command
PORCP1detail3.Process
PORCP1headerFields("DATE").Value = MySet!DELDATE ' Receipt Date
PORCP1detail5Fields("FUNCTION").Value = "61" ' Function
PORCP1detail5.Process
PORCP1headerFields("STCODE").Value = MySet!LOCATION ' Ship-To Location

PORCP1headerFields("DESCRIPTIO").Value = "Del. Note: " & MySet!DELNOTENUM & " - Truck Reg.: " & MySet!TRUCKREG ' Description
PORCP1headerFields("REFERENCE").Value = MySet!DELNOTENUM ' Reference

PORCP1detail1Fields("RCPLREV").PutWithoutVerification ("-1") ' Line Number

PORCP1detail1Fields("RCPLREV").PutWithoutVerification ("-1") ' Line Number
'******ERROR****
PORCP1detail1.Read
'******ERROR****
PORCP1detail1Fields("LOCATION").Value = MySet!LOCATION ' Location
'******ERROR****
PORCP1detail1Fields("RQRECEIVED").Value = MySet!DELQTY ' Quantity Received
If MySet!DELQTY >= PORCP1detail1Fields("OQORDERED").Value Then
'******ERROR****
PORCP1detail1Fields("POCOMPLETE").Value = "-1" ' Completes PO
ElseIf (MySet!DELQTY - PORCP1detail1Fields("RQRECEIVED").Value) / PORCP1detail1Fields("OQORDERED").Value = 0.02 Then
'******ERROR****
PORCP1detail1Fields("POCOMPLETE").Value = "-1" ' Completes PO and Cancel Remainder
PORCP1detail1Fields("RQCANCELED").Value = MySet!DELQTY - PORCP1detail1Fields("RQRECEIVED").Value ' Quantity Canceled
Else
PORCP1detail1Fields("POCOMPLETE").Value = "-1" ' Completes PO - NO
End If

'******ERROR****
PORCP1detail1.Update

PORCP1detail1Fields("RCPLREV").PutWithoutVerification ("-1") ' Line Number
'******ERROR****
PORCP1detail1.Read
PORCP1detail3.Browse "(RCPHSEQ = " & MySeq & ")", 1
PORCP1detail3.RecordClear
PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("10") ' Function
'******ERROR****
PORCP1detail5.Process
'******ERROR****
PORCP1header.Insert
MyDocNum = PORCP1headerFields("RCPNUMBER").Value ' Read Receipt number
PORCP1detail5Fields("RCPHSEQ").PutWithoutVerification (MySeq) ' Receipt Sequence Key

PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("2") ' Function

'Update processed lines
DoCmd.SetWarnings False
DoCmd.RunSQL "Update dbo_DelNotes SET dbo_DelNotes.PROCESSED = -1, dbo_DelNotes.PROCDATE = #" & Format(Now(), "yyyy/MM/dd HH:mm:ss") & "#, dbo_DelNotes.RCPTNUM ='" & MyDocNum & "' where dbo_DelNotes.UnqID = " & MySet!UnqID
DoCmd.SetWarnings True

PORCP1detail5.Process
Dim POPRNT2 As AccpacCOMAPI.AccpacView
'******ERROR****
Dim POPRNT2Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0640", POPRNT2
Set POPRNT2Fields = POPRNT2.Fields


Dim rpt As AccpacCOMAPI.AccpacReport
'******ERROR****
Set rpt = ReportSelect("PORCP01[PORCP01.RPT]", " ", " ")
Dim rptPrintSetup As AccpacCOMAPI.AccpacPrintSetup
'******ERROR****
Set rptPrintSetup = GetPrintSetup(" ", " ")
'******ERROR****
rptPrintSetup.DeviceName = "Feeds_copy&print_general"
'******ERROR****
rptPrintSetup.OutputName = "10.10.5.233"
'******ERROR****
rptPrintSetup.Orientation = 1
'******ERROR****
rptPrintSetup.PaperSize = 1
'******ERROR****
rptPrintSetup.PaperSource = 15
'******ERROR****
rpt.PrinterSetup rptPrintSetup
'******ERROR****
rpt.SetParam "RCPFROM", MyDocNum ' Report parameter: 2
'******ERROR****
rpt.SetParam "RCPTO", MyDocNum ' Report parameter: 3
'******ERROR****
rpt.SetParam "PRINTED", "1" ' Report parameter: 4
'******ERROR****
rpt.SetParam "QTYDEC", "4" ' Report parameter: 5
'******ERROR****
rpt.NumOfCopies = 1
'******ERROR****
rpt.Destination = PD_PREVIEW
'******ERROR****
rpt.PrintDir = ""
rpt.PrintReport
POPRNT2.Init

POPRNT2Fields("DOCTYPE").PutWithoutVerification ("3") ' Document Type
POPRNT2Fields("FROMRCP").PutWithoutVerification (MyDocNum) ' From Receipt Number
POPRNT2Fields("TORCP").PutWithoutVerification (MyDocNum) ' To Receipt Number

POPRNT2.Process

PORCP1header.Init
PORCP1header.Order = 0

PORCP1headerFields("RCPHSEQ").PutWithoutVerification ("0") ' Receipt Sequence Key

PORCP1header.Init
PORCP1header.Order = 1
PORCP1detail1.RecordClear
PORCP1detail3.RecordClear
PORCP1detail4.RecordClear
PORCP1detail6.Init
PORCP1detail2.Init

MySet.MoveNext

Loop
MySet.Close
 
In your error handler, I would recommend removing 'Resume Next' because if one section is giving you an error, the remaining statements will not function properly anyway (which is why you have so many errors).

If at first you don't succeed, then sky diving wasn't meant for you!
 
In the declaration section of your first post, what is MySeq?

If at first you don't succeed, then sky diving wasn't meant for you!
 
Thanks for joining in, Bluejay

I use MySeq to pick up the unique reference in the header table, to pass to portions of the code that had the reference hardcoded when I created the macro in Accpac. Do not know if they are critical in the execution of the PO Receipt?

PORCP1detail3.Browse "(RCPHSEQ = " & MySeq & ")", 1

If I remove the 'resume next' the remainder of the function will terminate. I agree. I will eventually remove it, but for development purposes I would like to view all the errors. There are statements that run after an error was displayed.

Even if I use the exact same code that was created by recording the macro, my first error stays the same. (I process only portions of the PO to make sure that the PO is not over receipted.)
 
Hi ajwonder,
but for development purposes I would like to view all the errors.
This is what I was trying to point out. Focus on one error at a time. Most of the remaining errors will be eliminated when the first error is addressed.

Also, I asked the question regarding MySeq because you do not have it declared as a specific type (eg. string). With no declaration, it defaults to an object. Perhaps forcing a declaration type may assist your modified macro.

What I find odd about your code is that you are continously switching from header to detail references. Typically when updating, you first access the batch (if required), then the header and finally the details. The update works in reverse: update the details, update the header, update the batch (if required).

If at first you don't succeed, then sky diving wasn't meant for you!
 
Thanks.

Will try and will keep you posted. The sequence of the events is excactly in the same order as recorded in the macro.

Will play around with the sequence and keep you posted.

I really appreciate your inputs.
 
My guess would be that the PO number you're entering is either complete or doesn't exist. You don't have to specify the vendor number when receiving a PO. You can simply indicate the PO to load:

Code:
    PORCP1header.Fields("PONUMBER").Value = aPONumber
    With PORCP1detail5
        .Fields("LOADPORNUM").Value = aPONumber
        .Fields("FUNCTION").PutWithoutVerification ("4")          ' Function
        .Process
    End With
 
Thanks. I am starting afresh with the basics and your suggestions. Thanks for all the advice. Much appreciated!
 
Nice to have capable friends on the other side of the world! Thanks a mill. The [with .... end with] clause made all the difference.
 
The last thing I strugle with is to automate the printing of the receiving slips. I am trying to be "clever" and print the report in the same go, but receive an error "SESSION NOT OPEN" at
[Set rpt = ReportSelect("PORCP01[PORCP01.RPT]", " ", " ")


Dim POPRNT2 As AccpacCOMAPI.AccpacView
Dim POPRNT2Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0640", POPRNT2
Set POPRNT2Fields = POPRNT2.Fields


Dim rpt As AccpacCOMAPI.AccpacReport
Set rpt = ReportSelect("PORCP01[PORCP01.RPT]", " ", " ")
Dim rptPrintSetup As AccpacCOMAPI.AccpacPrintSetup
Set rptPrintSetup = GetPrintSetup(" ", " ")
rptPrintSetup.DeviceName = "PrinterName"
rptPrintSetup.OutputName = "10.10.5.233"
rptPrintSetup.Orientation = 1
rptPrintSetup.PaperSize = 1
rptPrintSetup.PaperSource = 15
rpt.PrinterSetup rptPrintSetup
rpt.SetParam "RCPFROM", FromRcptNum
rpt.SetParam "RCPTO", ToRcptNum
rpt.SetParam "PRINTED", "1"
rpt.SetParam "QTYDEC", "4"
rpt.NumOfCopies = 1
rpt.Destination = PD_PREVIEW
rpt.PrintDir = ""
rpt.PrintReport
temp = POPRNT2.Exists
POPRNT2.Init

POPRNT2Fields("DOCTYPE").PutWithoutVerification ("3")
POPRNT2Fields("FROMRCP").PutWithoutVerification (FromRcptNum)
POPRNT2Fields("TORCP").PutWithoutVerification (ToRcptNum)

POPRNT2.Process

I've even tried to re-direct the session to use P/O Forms Receiving slips by including [OpenMyModule "PO", "PO3030"], with no luck . . . .
 
Perhaps the program is not recognizing the path of the report.

If at first you don't succeed, then sky diving wasn't meant for you!
 
Make sure that the macro is using the correct session object when you call:
Code:
Set rpt = ReportSelect("PORCP01[PORCP01.RPT]", "      ", "      ")
 
This is getting the better of my abilities.

I've looked at the Sage User Guide and found the exact same code:

Dim rpt As AccpacCOMAPI.AccpacReport
Set rpt = ReportSelect("GLOPT01", " ", " ")
Dim rptPrintSetup As AccpacCOMAPI.AccpacPrintSetup
Set rptPrintSetup = GetPrintSetup(" ", " ")
rptPrintSetup.DeviceName = "DOC-Laser"
rptPrintSetup.OutputName = "\\603wps01\doc-laser"
rptPrintSetup.Orientation = 10
rptPrintSetup.PaperSize = 300
rptPrintSetup.PaperSource = 7
rpt.PrinterSetup rptPrintSetup
rpt.NumOfCopies = 1
rpt.Destination = PD_PREVIEW
rpt.PrintDir = ""
rpt.PrintReport

But when I call Set rpt = ReportSelect("GLOPT01", " ", " ") I get a runtime error -2147467259 (80004005): Session is not opened.

I do a signon on "GL", "GL4113" as this should open the session.

The only difference between the sample and my recorded macro is ReportSelect("GLOPT01", " ", " ") vs ReportSelect("GLOPT01[GLOPT01.RPT]", " ", " ")

I've tried ("GLOPT01.RPT"), tried to map the path and also to include the MenuID and ProgramID in the ReportSelect
 
Show us the OpenMyModule code and where you declare your session variable.
 
Sign On Session:
Option Compare Database
Option Explicit

Public Session As AccpacSession
Public Signon As AccpacSessionMgr
Public lSignonID As String
Public AnyError As Boolean
Public OpenSession As Boolean
Public mDBLinkCmpRW As AccpacCOMAPI.AccpacDBLink
Public mDBLinkSysRW As AccpacCOMAPI.AccpacDBLink
Public Accpac_User As String
Public Accpac_CompanyID As String
Public Accpac_CompanyName As String
Public Function OpenMyModule(MyAppID As String, MyProg As String)
On Error GoTo Err_OpenModule
' -------------------------------------------------------------------------------------------------
'Open or Tap into existing accpac session
'If no session is found, the code will open the Accpac Sign On screen.
OpenSession = False
lSignonID = 0
Set Signon = New AccpacSessionMgr
With Signon
.AppVersion = "55A"
.AppID = MyAppID
.ProgramName = MyProg
.ForceNewSignon = False
.CreateSession "", 1, Session
End With
OpenSession = True
Accpac_User = Session.UserID
Accpac_CompanyID = Session.CompanyID
Accpac_CompanyName = Session.CompanyName

Set mDBLinkCmpRW = Session.OpenDBLink(AccpacCOMAPI.DBLINK_COMPANY, AccpacCOMAPI.DBLINK_FLG_READWRITE)
Set mDBLinkSysRW = Session.OpenDBLink(AccpacCOMAPI.DBLINK_SYSTEM, AccpacCOMAPI.DBLINK_FLG_READWRITE)

Select Case Err.Description
Case "OBJECT REFERENCE NOT SET TO AN INSTANCE OF AN OBJECT."
Accpac_User = "Not Logged In"
Accpac_CompanyID = "No Company ID"
Accpac_CompanyName = "No Company Name"
MsgBox "You have to be loged in to a Accpac session.", vbCritical, "Warning"
Case Else
Dim lCount As Long
Dim lIndex As Long

If Session.Errors Is Nothing Then
MsgBox Err.Description
Else
lCount = Session.Errors.Count

If lCount = 0 Then
If Err.Description <> "" Then
MsgBox Err.Description
End If
Else
For lIndex = 0 To lCount - 1
MsgBox Session.Errors.Item(lIndex)
Next
Session.Errors.Clear
End If

End If

Exit Function
End Select

Exit_OpenModule:
Exit Function

Err_OpenModule:
MsgBox Err.Description
Resume Exit_OpenModule

End Function



Example of code to print Transfer Slip:
Option Compare Database
Option Explicit

Public Function PrintTrfSlips(FromTrfSlip As String, ToTrfSlip As String)

On Error GoTo ACCPACErrorHandler

OpenMyModule "IC", "IC3413"

Dim temp As Boolean
Dim rpt As AccpacCOMAPI.AccpacReport
Set rpt = ReportSelect("ICTRNS01[ICTRNS01.RPT]", " ", " ")
Dim rptPrintSetup As AccpacCOMAPI.AccpacPrintSetup
Set rptPrintSetup = GetPrintSetup(" ", " ")
rptPrintSetup.DeviceName = "Feeds_copy&print_general"
rptPrintSetup.OutputName = "10.10.5.233"
rptPrintSetup.Orientation = 1
rptPrintSetup.PaperSize = 1
rptPrintSetup.PaperSource = 15
rpt.PrinterSetup rptPrintSetup
rpt.SetParam "TRNSFROM", FromTrfSlip ' Report parameter: 2
rpt.SetParam "TRNSTO", ToTrfSlip ' Report parameter: 3
rpt.SetParam "SWPRINTED", "1" ' Report parameter: 4
rpt.SetParam "QTYDEC", "4" ' Report parameter: 5
rpt.NumOfCopies = 1
rpt.Destination = PD_PREVIEW
rpt.PrintDir = ""
rpt.PrintReport

Exit Function

ACCPACErrorHandler:
Dim lCount As Long
Dim lIndex As Long

If Errors Is Nothing Then
MsgBox Err.Description
Else
lCount = Errors.Count

If lCount = 0 Then
MsgBox Err.Description
Err.Clear
Else
For lIndex = 0 To lCount - 1
MsgBox Errors.Item(lIndex)
Next
Err.Clear
End If
Resume Next

End If

End Function

 
EUREKA!!!!!!

Set rpt = ReportSelect("ICTRNS01[ICTRNS01.RPT]", " ", " ")

should be:

Set rpt = SESSION.ReportSelect("ICTRNS01[ICTRNS01.RPT]", " ", " ")

No better school than trial and error!!

Will never forget today's class.

Thank you for every input.


 
Glad you finally got it working.
Thank you as well for posting your solution.

If at first you don't succeed, then sky diving wasn't meant for you!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top