Private Sub cmdGenerate_Click() Dim oEdiDoc As Fredi.ediDocument Dim oSchema As Fredi.ediSchema Dim oInterchange As Fredi.ediInterchange Dim oGroup As Fredi.ediGroup Dim oTransactionset As Fredi.ediTransactionSet Dim oSegment As Fredi.ediDataSegment Dim oConn As ADODB.Connection Dim oRsInterchange As ADODB.Recordset Dim oRsGroup As ADODB.Recordset Dim oRsTS810_Header As ADODB.Recordset Dim oRsTS810_Detail As ADODB.Recordset Dim sConn As String Dim sSefFile As String Dim sEdiFile As String Dim sPath As String sPath = CurrentProject.Path & "\" sConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sPath & "Example810.mdb" Set oConn = New ADODB.Connection oConn.Open sConn 'The InterchangeIndex table contains information of Interchange. Set oRsInterchange = New ADODB.Recordset 'The GroupIndex table contains information of the Functional Group. Set oRsGroup = New ADODB.Recordset 'The TS810_Header table contains information of the Transaction Sets Area1 and Area 3 Set oRs810Header = New ADODB.Recordset 'The TS810_Detail table contains information of the Transaction Set in Area2 Set oRs810Detail = New ADODB.Recordset sSefFile = "810_004010.EVAL0.SEF" sEdiFile = "810_output.x12" Set oEdiDoc = New Fredi.ediDocument oEdiDoc.CursorType = Cursor_ForwardWrite 'Makes certain that the internal Standard Reference Library is not used, but only 'the SEF file provided. Set oSchemas = oEdiDoc.GetSchemas oSchemas.EnableStandardReference = False 'Loads the SEF file and EDI file. oEdiDoc.LoadSchema sPath & sSefFile, 0 oEdiDoc.SegmentTerminator = "~" & vbCrLf oEdiDoc.ElementTerminator = "*" oEdiDoc.CompositeTerminator = ">" oRsInterchange.Open "Select * from Interchange", oConn, adOpenDynamic, adLockOptimistic Do While Not oRsInterchange.EOF Set oInterchange = oEdiDoc.CreateInterchange("X", "004010") Set oSegment = oInterchange.GetDataSegmentHeader oSegment.DataElementValue(1) = oRsInterchange("ISA01_AuthorizationInformationQualifier").Value ' Authorization Information Qualifier (I01) oSegment.DataElementValue(2) = oRsInterchange("ISA02_AuthorizationInformation").Value ' Authorization Information (I02) oSegment.DataElementValue(3) = oRsInterchange("ISA03_SecurityInformationQualifier").Value ' Security Information Qualifier (I03) oSegment.DataElementValue(4) = oRsInterchange("ISA04_SecurityInformation").Value ' Security Information (I04) oSegment.DataElementValue(5) = oRsInterchange("ISA05_InterchangeIdQualifier").Value ' Interchange ID Qualifier (I05) oSegment.DataElementValue(6) = oRsInterchange("ISA06_InterchangeSenderId").Value ' Interchange Sender ID (I06) oSegment.DataElementValue(7) = oRsInterchange("ISA07_InterchangeIdQualifier").Value ' Interchange ID Qualifier (I05) oSegment.DataElementValue(8) = oRsInterchange("ISA08_InterchangeReceiverId").Value ' Interchange Receiver ID (I07) oSegment.DataElementValue(9) = oRsInterchange("ISA09_InterchangeDate").Value ' Interchange Date (I08) oSegment.DataElementValue(10) = oRsInterchange("ISA10_InterchangeTime").Value ' Interchange Time (I09) oSegment.DataElementValue(11) = oRsInterchange("ISA11_InterchangeControlStandardsIdentifier").Value ' Interchange Control Standards Identifier (I10) oSegment.DataElementValue(12) = oRsInterchange("ISA12_InterchangeControlVersionNumber").Value ' Interchange Control Version Number (I11) oSegment.DataElementValue(13) = oRsInterchange("ISA13_InterchangeControlNumber").Value ' Interchange Control Number (I12) oSegment.DataElementValue(14) = oRsInterchange("ISA14_AcknowledgmentRequested").Value ' Acknowledgment Requested (I13) oSegment.DataElementValue(15) = oRsInterchange("ISA15_UsageIndicator").Value ' Usage Indicator (I14) oSegment.DataElementValue(16) = oRsInterchange("ISA16_ComponentElementSeparator").Value ' Component Element Separator (I15) oRsGroup.Open "Select * from FunctionalGroup where InterKey = " & oRsInterchange("InterKey").Value, oConn, adOpenDynamic, adLockOptimistic Do While Not oRsGroup.EOF Set oGroup = oInterchange.CreateGroup("004010") Set oSegment = oGroup.GetDataSegmentHeader oSegment.DataElementValue(1) = oRsGroup("GS01_FunctionalIdentifierCode").Value ' Functional Identifier Code (479) oSegment.DataElementValue(2) = oRsGroup("GS02_ApplicationSendersCode").Value ' Application Sender's Code (142) oSegment.DataElementValue(3) = oRsGroup("GS03_ApplicationReceiversCode").Value ' Application Receiver's Code (124) oSegment.DataElementValue(4) = oRsGroup("GS04_Date").Value ' Date (373) oSegment.DataElementValue(5) = oRsGroup("GS05_Time").Value ' Time (337) oSegment.DataElementValue(6) = oRsGroup("GS06_GroupControlNumber").Value ' Group Control Number (28) oSegment.DataElementValue(7) = oRsGroup("GS07_ResponsibleAgencyCode").Value ' Responsible Agency Code (455) oSegment.DataElementValue(8) = oRsGroup("GS08_VersionReleaseIndustryIdentifierCode").Value ' Version / Release / Industry Identifier Code (480) oRs810Header.Open "Select * from TS810_Header where GroupKey = " & oRsGroup("GroupKey").Value, oConn, adOpenDynamic, adLockOptimistic Do While Not oRs810Header.EOF ' Creates the Transaction Set header segment (ST). Set oTransactionset = oGroup.CreateTransactionSet("810") Set oSegment = oTransactionset.GetDataSegmentHeader oSegment.DataElementValue(1) = oRs810Header("ST01_TransactionSetIdentifierCode").Value ' Transaction Set Identifier Code (143) oSegment.DataElementValue(2) = oRs810Header("ST02_TransactionSetControlNumber").Value ' Transaction Set Control Number (329) ' Beginning Segment for Invoice (BIG) Set oSegment = oTransactionset.CreateDataSegment("BIG") oSegment.DataElementValue(1) = oRs810Header("BIG01_Date").Value ' Date (373) oSegment.DataElementValue(2) = oRs810Header("BIG02_InvoiceNumber").Value ' Invoice Number (76) oSegment.DataElementValue(4) = oRs810Header("BIG04_PurchaseOrderNumber").Value ' Purchase Order Number (324) oSegment.DataElementValue(7) = oRs810Header("BIG07_TransactionTypeCode").Value ' Transaction Type Code (640) ' Currency (CUR) Set oSegment = oTransactionset.CreateDataSegment("CUR") oSegment.DataElementValue(1) = oRs810Header("CUR01_EntityIdentifierCode").Value ' Entity Identifier Code (98) oSegment.DataElementValue(2) = oRs810Header("CUR02_CurrencyCode").Value ' Currency Code (100) ' Reference Identification (REF) If oRs810Header("REF02_VendorID_Number").Value & "" <> "" Then Set oSegment = oTransactionset.CreateDataSegment("REF") oSegment.DataElementValue(1) = "01" ' Reference Identification Qualifier (128) oSegment.DataElementValue(2) = oRs810Header("REF02_VendorID_Number").Value ' Reference Identification (127) End If ' Ship To Name (N1) If oRs810Header("N102_ShipToName").Value & "" <> "" Then Set oSegment = oTransactionset.CreateDataSegment("N1\N1") oSegment.DataElementValue(1) = "ST" ' Entity Identifier Code (98) oSegment.DataElementValue(2) = oRs810Header("N102_ShipToName").Value ' Name (93) End If ' Bill To Name (N1) If oRs810Header("N102_BillToName").Value & "" <> "" Then Set oSegment = oTransactionset.CreateDataSegment("N1\N1") oSegment.DataElementValue(1) = "BT" ' Entity Identifier Code (98) oSegment.DataElementValue(2) = oRs810Header("N102_BillToName").Value ' Name (93) End If ' Ordered By Name (N1) If oRs810Header("N102_OrderedByName").Value & "" <> "" Then Set oSegment = oTransactionset.CreateDataSegment("N1\N1") oSegment.DataElementValue(1) = "OB" ' Entity Identifier Code (98) oSegment.DataElementValue(2) = oRs810Header("N102_OrderedByName").Value ' Name (93) End If ' Terms of Sale/Deferred Terms of Sale (ITD) Set oSegment = oTransactionset.CreateDataSegment("ITD") oSegment.DataElementValue(1) = oRs810Header("ITD01_TermsTypeCode").Value ' Terms Type Code (336) oSegment.DataElementValue(2) = oRs810Header("ITD02_TermsBasisDateCode").Value ' Terms Basis Date Code (333) oSegment.DataElementValue(3) = oRs810Header("ITD03_TermsDiscountPercent").Value ' Terms Discount Percent (338) oSegment.DataElementValue(4) = oRs810Header("ITD04_TermsDiscountDueDate").Value ' Terms Discount Due Date (370) oSegment.DataElementValue(5) = oRs810Header("ITD05_TermsDiscountDaysDue").Value ' Terms Discount Days Due (351) oSegment.DataElementValue(6) = oRs810Header("ITD06_TermsNetDueDate").Value ' Terms Net Due Date (446) oSegment.DataElementValue(7) = oRs810Header("ITD07_TermsNetDays").Value ' Terms Net Days (386) oSegment.DataElementValue(8) = oRs810Header("ITD08_TermsDiscountAmount").Value ' Terms Discount Amount (362) oSegment.DataElementValue(12) = oRs810Header("ITD12_Description").Value ' Description (352) oSegment.DataElementValue(13) = oRs810Header("ITD13_DayOfMonth").Value ' Day of Month (765) ' Date/Time Reference (DTM) If oRs810Header("DTM02_ShippedDate").Value & "" <> "" Then Set oSegment = oTransactionset.CreateDataSegment("DTM") oSegment.DataElementValue(1) = "011" ' Date/Time Qualifier (374) oSegment.DataElementValue(2) = oRs810Header("DTM02_ShippedDate").Value ' Date (373) End If oRs810Detail.Open "Select * from TS810_Detail where HeaderKey = " & oRs810Header("HeaderKey").Value, oConn, adOpenDynamic, adLockOptimistic Do While Not oRs810Detail.EOF ' Baseline Item Data (Invoice) (IT1) Set oSegment = oTransactionset.CreateDataSegment("IT1\IT1") oSegment.DataElementValue(1) = oRs810Detail("IT101_AssignedIdentification").Value ' Assigned Identification (350) oSegment.DataElementValue(2) = oRs810Detail("IT102_QuantityInvoiced").Value ' Quantity Invoiced (358) oSegment.DataElementValue(3) = oRs810Detail("IT103_UnitOrBasisForMeasurementCode").Value ' Unit or Basis for Measurement Code (355) oSegment.DataElementValue(4) = oRs810Detail("IT104_UnitPrice").Value ' Unit Price (212) oSegment.DataElementValue(6) = "A1" ' Product/Service ID Qualifier (235) oSegment.DataElementValue(7) = oRs810Detail("IT107_SKU_Number").Value ' Product/Service ID (234) oSegment.DataElementValue(8) = "A1" ' Product/Service ID Qualifier (235) oSegment.DataElementValue(9) = oRs810Detail("IT109_VendorPartNumber").Value ' Product/Service ID (234) ' Product/Item Description (PID) If oRs810Detail("PID05_Description").Value & "" <> "" Then Set oSegment = oTransactionset.CreateDataSegment("IT1\PID\PID") oSegment.DataElementValue(1) = "F" ' Item Description Type (349) oSegment.DataElementValue(5) = oRs810Detail("PID05_Description").Value ' Description (352) End If oRs810Detail.MoveNext Loop ' oRs810Detail oRs810Detail.Close ' Total Monetary Value Summary (TDS) Set oSegment = oTransactionset.CreateDataSegment("TDS") oSegment.DataElementValue(1) = oRs810Header("TDS01_GrossInvoiceAmount").Value ' Amount (610) oSegment.DataElementValue(2) = oRs810Header("TDS02_GrossAmountApplicableDiscount").Value ' Amount (610) oSegment.DataElementValue(3) = oRs810Header("TDS03_NetInvoiceAmount").Value ' Amount (610) ' Carrier Detail (CAD) Set oSegment = oTransactionset.CreateDataSegment("CAD") oSegment.DataElementValue(1) = oRs810Header("CAD01_TransportationMethodTypeCode").Value ' Transportation Method/Type Code (91) oSegment.DataElementValue(2) = oRs810Header("CAD02_EquipmentInitial").Value ' Equipment Initial (206) oSegment.DataElementValue(3) = oRs810Header("CAD03_EquipmentNumber").Value ' Equipment Number (207) oSegment.DataElementValue(4) = oRs810Header("CAD04_StandardCarrierAlphaCode").Value ' Standard Carrier Alpha Code (140) oSegment.DataElementValue(5) = oRs810Header("CAD05_Routing").Value ' Routing (387) ' Service, Promotion, Allowance, or Charge Information (SAC) Set oSegment = oTransactionset.CreateDataSegment("SAC\SAC") oSegment.DataElementValue(1) = oRs810Header("SAC01_AllowanceOrChargeIndicator").Value ' Allowance or Charge Indicator (248) oSegment.DataElementValue(2) = oRs810Header("SAC02_ServicePromotionAllowanceOrChargeCode").Value ' Service, Promotion, Allowance, or Charge Code (1300) oSegment.DataElementValue(5) = oRs810Header("SAC05_Amount").Value ' Amount (610) ' Transaction Totals (CTT) Set oSegment = oTransactionset.CreateDataSegment("CTT") oSegment.DataElementValue(1) = oRs810Header("CTT01_NumberOfLineItems").Value ' Number of Line Items (354) oRs810Header.MoveNext Loop ' oRs810Header oRs810Header.Close oRsGroup.MoveNext Loop ' oRsGroup oRsGroup.Close oRsInterchange.MoveNext Loop ' oRsInterchange oRsInterchange.Close oEdiDoc.Save sPath & sEdiFile MsgBox (oEdiDoc.GetEdiString) End Sub