Private Sub cmdGenerate_Click()
'Routine that takes data from a database and maps them to data elements to create an 850 EDI file
Dim i As Integer
Dim nCount As Integer
Dim sEntity As String
Dim nIndex As Integer
Dim sSefFile As String
Dim sEdiFile As String
Dim iItemCount As Integer
Dim nInstance As Integer
Me.MousePointer = vbHourglass
sSefFile = "850_X12-4010.sef"
sEdiFile = "850OUTPUT.x12"
'instantiate edi document object
Set oEdiDoc = New Fredi.ediDocument
'change cursor type to forwardwrite so that the component does not keep the segments it creates in memory. Saves RAM and improves performance.
oEdiDoc.CursorType = Cursor_ForwardWrite
'disable internal standard reference library to make certain SEF files provided are used. Improves performance.
Set oSchemas = oEdiDoc.GetSchemas
oSchemas.EnableStandardReference = False
'loads SEF files
oEdiDoc.ImportSchema sPath & sSefFile, 0
'set terminators
oEdiDoc.SegmentTerminator = "~" & vbCrLf
oEdiDoc.ElementTerminator = "*"
oEdiDoc.CompositeTerminator = ">"
oRsInterchange.Open "Select * from InterchangeIndex", oConn, adOpenDynamic, adLockOptimistic
Do While Not oRsInterchange.EOF
'creates ISA segment
Set oInterchange = oEdiDoc.CreateInterchange("X", "004010")
Set oSegment = oInterchange.GetDataSegmentHeader
oSegment.DataElementValue(1) = "00"
oSegment.DataElementValue(3) = "00"
oSegment.DataElementValue(5) = oRsInterchange("SenderID_Qlfr").Value
oSegment.DataElementValue(6) = oRsInterchange("SenderID").Value
oSegment.DataElementValue(7) = oRsInterchange("ReceiverID_Qlfr").Value
oSegment.DataElementValue(8) = oRsInterchange("ReceiverID").Value
oSegment.DataElementValue(9) = "960807"
oSegment.DataElementValue(10) = "1548"
oSegment.DataElementValue(11) = "U"
oSegment.DataElementValue(12) = oRsInterchange("Version").Value
oSegment.DataElementValue(13) = oRsInterchange("InterchangeControlNo").Value
oSegment.DataElementValue(14) = "0"
oSegment.DataElementValue(15) = "T"
oSegment.DataElementValue(16) = ">"
oRsGroup.Open "Select * from GroupIndex where InterchangeKey = " & oRsInterchange("InterchangeKey").Value, oConn, adOpenDynamic, adLockOptimistic
Do While Not oRsGroup.EOF
'creates GS segment
Set oGroup = oInterchange.CreateGroup("004010")
Set oSegment = oGroup.GetDataSegmentHeader
oSegment.DataElementValue(1) = oRsGroup("FunctionalIdCode").Value
oSegment.DataElementValue(2) = oRsGroup("SenderDept").Value
oSegment.DataElementValue(3) = oRsGroup("ReceiverDept").Value
oSegment.DataElementValue(4) = "19960807"
oSegment.DataElementValue(5) = "1548"
oSegment.DataElementValue(6) = oRsGroup("GroupNo").Value
oSegment.DataElementValue(7) = "X"
oSegment.DataElementValue(8) = oRsGroup("Version").Value
oRsTransactionSet.Open "Select * from TransactionSetIndex where GroupKey = " & oRsGroup("GroupKey").Value, oConn, adOpenDynamic, adLockOptimistic
Do While Not oRsTransactionSet.EOF
'creates ST segment
Set oTransactionset = oGroup.CreateTransactionSet("850")
Set oSegment = oTransactionset.GetDataSegmentHeader
oSegment.DataElementValue(2) = oRsTransactionSet("TransactionSetControlNo").Value
oRsPOMaster.Open "Select * from POMaster where TsKey = " & oRsTransactionSet("TsKey").Value, oConn, adOpenDynamic, adLockOptimistic
Do While Not oRsPOMaster.EOF
'create BEG segment
Set oSegment = oTransactionset.CreateDataSegment("BEG")
oSegment.DataElementValue(1) = "00"
oSegment.DataElementValue(2) = "SA"
oSegment.DataElementValue(3) = oRsPOMaster("PONumber").Value
oSegment.DataElementValue(5) = Format(oRsPOMaster("PODate").Value, "YYYYMMDD")
Set oSegment = oTransactionset.CreateDataSegment("REF")
oSegment.DataElementValue(1) = "VR"
oSegment.DataElementValue(2) = oRsPOMaster("VendorIDNo").Value
Set oSegment = oTransactionset.CreateDataSegment("ITD")
oSegment.DataElementValue(1) = "01"
oSegment.DataElementValue(2) = "3"
oSegment.DataElementValue(3) = oRsPOMaster("DiscountPerc").Value
oSegment.DataElementValue(5) = oRsPOMaster("DiscountDaysDue").Value
oSegment.DataElementValue(7) = oRsPOMaster("NetDays").Value
Set oSegment = oTransactionset.CreateDataSegment("DTM")
oSegment.DataElementValue(1) = "002"
oSegment.DataElementValue(2) = Format(oRsPOMaster("DeliveryDate").Value, "YYYYMMDD")
'BILL TO
'creates the N1 segment in N1 loop
Set oSegment = oTransactionset.CreateDataSegment("N1\N1")
oSegment.DataElementValue(1) = "BT"
oSegment.DataElementValue(2) = oRsPOMaster("BillToName").Value
oSegment.DataElementValue(3) = "9"
oSegment.DataElementValue(4) = oRsPOMaster("BillToID").Value
'creates the N3 segment in N1 loop
Set oSegment = oTransactionset.CreateDataSegment("N1\N3")
oSegment.DataElementValue(1) = oRsPOMaster("BillToAddress").Value
'creates the N4 segment in N1 loop
Set oSegment = oTransactionset.CreateDataSegment("N1\N4")
oSegment.DataElementValue(1) = oRsPOMaster("BillToCity").Value
oSegment.DataElementValue(2) = oRsPOMaster("BillToState").Value
oSegment.DataElementValue(3) = oRsPOMaster("BillToZip").Value
'SHIP TO
'creates the N1 segment in the second instance of the N1 loop
Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N1")
oSegment.DataElementValue(1) = "ST"
oSegment.DataElementValue(2) = oRsPOMaster("ShipToName").Value
oSegment.DataElementValue(3) = "9"
oSegment.DataElementValue(4) = oRsPOMaster("ShipToID").Value
'creates the N3 segment in the second instance of the N1 loop
Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N3")
oSegment.DataElementValue(1) = oRsPOMaster("ShipToAddress").Value
'creates the N4 segment in the second instance of the N1 loop
Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N4")
oSegment.DataElementValue(1) = oRsPOMaster("ShipToCity").Value
oSegment.DataElementValue(2) = oRsPOMaster("ShipToState").Value
oSegment.DataElementValue(3) = oRsPOMaster("ShipToZip").Value
oRsPODetail.Open "Select * from PODetail where PoMasterKey = " & oRsPOMaster("PoMasterKey").Value, oConn, adOpenDynamic, adLockOptimistic
nInstance = 0
Do While Not oRsPODetail.EOF
nInstance = nInstance + 1
Set oSegment = oTransactionset.CreateDataSegment("PO1(" & nInstance & ")\PO1")
oSegment.DataElementValue(2) = oRsPODetail.Fields("Quantity")
oSegment.DataElementValue(3) = oRsPODetail.Fields("Unit")
oSegment.DataElementValue(4) = oRsPODetail.Fields("UnitPrice")
oSegment.DataElementValue(5) = " "
oSegment.DataElementValue(6) = "CB"
oSegment.DataElementValue(7) = oRsPODetail.Fields("CatalogNo")
oSegment.DataElementValue(8) = "UA"
oSegment.DataElementValue(9) = oRsPODetail.Fields("EAN")
Set oSegment = oTransactionset.CreateDataSegment("PO1(" & nInstance & ")\PID\PID")
oSegment.DataElementValue(1) = "F"
oSegment.DataElementValue(5) = oRsPODetail.Fields("Description")
Set oSegment = oTransactionset.CreateDataSegment("PO1(" & nInstance & ")\PO4")
oSegment.DataElementValue(1) = oRsPODetail.Fields("Package")
oSegment.DataElementValue(2) = oRsPODetail.Fields("Weights")
oSegment.DataElementValue(3) = "LB"
oRsPODetail.MoveNext
Loop
oRsPODetail.Close
Set oSegment = oTransactionset.CreateDataSegment("CTT\CTT")
oSegment.DataElementValue(1) = nInstance
oRsPOMaster.MoveNext
Loop
oRsPOMaster.Close
oRsTransactionSet.MoveNext
Loop
oRsTransactionSet.Close
oRsGroup.MoveNext
Loop
oRsGroup.Close
oRsInterchange.MoveNext
Loop
oRsInterchange.Close
'writes edi object to file
oEdiDoc.Save sPath & sEdiFile
Me.MousePointer = vbNormal
MsgBox ("Done")
cmdGenerate.Enabled = False
End Sub
