Hi All,
I'm making a macro to post receipt entry based on PO number and the receipt number is pre-generated.
For the detail line, I do not want to receive all. But so far did not success.
How to prevent receive all?
Below is my code. I have set the quantity received.
Edit: Here is the full code
Private Sub ImportPO_Click()
On Error GoTo ACCPACErrorHandler
Dim mDBLinkCmpRW As AccpacCOMAPI.AccpacDBLink
Set mDBLinkCmpRW = OpenDBLink(DBLINK_COMPANY, DBLINK_FLG_READWRITE)
Dim mDBLinkSysRW As AccpacCOMAPI.AccpacDBLink
Set mDBLinkSysRW = OpenDBLink(DBLINK_SYSTEM, DBLINK_FLG_READWRITE)
Dim objExcelApp As Object
Set objExcelApp = CreateObject("Excel.Application")
Dim wb As Object
Set wb = objExcelApp.Workbooks.Open(TextBox1.Value) 'OPEN the excel file
Dim ws_one As Object
Set ws_one = wb.Sheets(1)
Set ws_two = wb.Sheets(2)
'First is row, then Column
'Read the rows
Dim last_row As Long
last_row_ws_one = ws_one.Cells(Rows.Count, 1).End(xlUp).Row
last_row_ws_two = ws_two.Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print "last_row_ws_one=" & last_row_ws_one
Debug.Print "last_row_ws_two=" & last_row_ws_two
Dim PONUM As String
For I = 2 To last_row_ws_one
PONUM = ws_one.Cells(I, 1).Value
' TODO: To increase efficiency, comment out any unused DB links.
Dim temp As Boolean
'-----------------------------------
'CREATE GRN
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
Dim PORCP1detail14 As AccpacCOMAPI.AccpacView
Dim PORCP1detail14Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0789", PORCP1detail14
Set PORCP1detail14Fields = PORCP1detail14.Fields
Dim PORCP1detail15 As AccpacCOMAPI.AccpacView
Dim PORCP1detail15Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "PO0780", PORCP1detail15
Set PORCP1detail15Fields = PORCP1detail15.Fields
PORCP1header.Compose Array(PORCP1detail2, PORCP1detail1, PORCP1detail3, PORCP1detail4, PORCP1detail5, PORCP1detail6, PORCP1detail7, PORCP1detail8)
PORCP1detail1.Compose Array(PORCP1header, PORCP1detail2, PORCP1detail5, Nothing, Nothing, PORCP1detail9, PORCP1detail14, PORCP1detail15)
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)
PORCP1detail14.Compose Array(PORCP1detail1, Nothing, Nothing)
PORCP1detail15.Compose Array(PORCP1detail1, Nothing, Nothing)
PORCP1header.Order = 1
PORCP1header.Order = 0
PORCP1headerFields("RCPHSEQ").PutWithoutVerification ("0") ' Receipt Sequence Key
'Debug.Print PORCP1headerFields("RCPHSEQ").Value
PORCP1header.Init
PORCP1header.Order = 1
temp = PORCP1detail1.Exists
PORCP1detail1.RecordClear
PORCP1detail3.RecordClear
temp = PORCP1detail4.Exists
PORCP1detail4.RecordClear
PORCP1detail6.Init
PORCP1detail2.Init
PORCP1headerFields("PONUMBER").Value = PONUM ' Purchase Order Number
'PORCP1header.Read
temp = PORCP1header.Exists
Debug.Print "PORCP1header temp:" & temp
PORCP1headerFields("DATE").Value = ws_one.Cells(I, 2) ' Receipt Date
PORCP1header.Order = 0
PORCP1detail5Fields("LOADPORNUM").Value = PONUM ' Purchase Order Number
PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("4") ' Function
PORCP1detail5.Process
PORCP1header.Order = 1
PORCP1detail3Fields("PROCESSCMD").PutWithoutVerification ("1") ' Command
PORCP1detail3.Process
temp = PORCP1header.Exists
Dim counter As Integer
counter = 0
For J = 2 To last_row_ws_two
Debug.Print "Trim(CStr(ws_two.Cells(" & J & ", 1)))=" & Trim(CStr(ws_two.Cells(J, 1)))
If Trim(PONUM) = Trim(CStr(ws_two.Cells(J, 2))) Then
For K = 1 To PORCP1headerFields("LINES").Value
PORCP1detail1Fields("RCPLREV").PutWithoutVerification (CStr(0 - K)) ' Line Number
PORCP1detail1.Read
If Trim(ws_two.Cells(J, 1).Value) = Trim(PORCP1detail1Fields("ITEMNO").Value) Then
PORCP1detail1Fields("DTARRIVAL").Value = ws_one.Cells(I, 2) ' Arrival Date
PORCP1detail1Fields("RQRECEIVED").Value = CStr(ws_two.Cells(J, 3).Value) ' Quantity Received
Debug.Print "ITEMNO = " & PORCP1detail1Fields("ITEMNO").Value
Debug.Print "DTARRIVAL=" & PORCP1detail1Fields("DTARRIVAL").Value
Debug.Print "RQRECEIVED=" & PORCP1detail1Fields("RQRECEIVED").Value
PORCP1detail1.Update
End If
Next K
End If
Next J
PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("4") ' Function
PORCP1detail5.Process
PORCP1header.Order = 1
PORCP1detail3Fields("PROCESSCMD").PutWithoutVerification ("1") ' Command
PORCP1detail3.Process
PORCP1detail5Fields("FUNCTION").Value = "6" ' Function
PORCP1detail5.Process
PORCP1detail3.Browse "(RCPHSEQ = 0)", 1
PORCP1detail3.RecordClear
PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("10") ' Function
PORCP1detail5.Process
temp = PORCP1header.Exists
PORCP1headerFields("RCPNUMBER").Value = ws_one.Cells(I, 3) ' GRN generated by Vendor
PORCP1header.Insert
PORCP1detail5Fields("RCPHSEQ").PutWithoutVerification (CStr(PORCP1headerFields("RCPHSEQ").Value)) ' Receipt Sequence Key
PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("2") ' Function
PORCP1detail5.Process
PORCP1header.Init
PORCP1header.Order = 0
PORCP1headerFields("RCPHSEQ").PutWithoutVerification ("0") ' Receipt Sequence Key
PORCP1header.Init
PORCP1header.Order = 1
temp = PORCP1detail1.Exists
PORCP1detail1.RecordClear
PORCP1detail3.RecordClear
temp = PORCP1detail4.Exists
PORCP1detail4.RecordClear
PORCP1detail6.Init
PORCP1detail2.Init
Next I
wb.Close
Exit Sub
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)
'MsgBox "The PO Number or GRN might be duplicated."
Next
Errors.Clear
End If
Resume Next
End If
End Sub
My excel file look like this:
1st Sheet:
2nd Sheet: