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