Private Sub cmdTranslate_Click() Dim oEdiDoc As Fredi.ediDocument Dim oSegment As Fredi.ediDataSegment Dim oSchemas As Fredi.ediSchemas 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 sPath As String Dim sSegmentID As String Dim sLoopSection As String Dim nArea As Integer Dim sSefFile As String Dim sEdiFile As String Dim i As Integer Dim sEntity As String Dim nInterKey As Long Dim nGroupKey As Long Dim nHeaderKey As Long Dim nDetailKey As Long nInterKey = 0 nGroupKey = 0 nHeaderKey = 0 nDetailKey = 0 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 stores information for each Interchange received. Set oRsInterchange = New ADODB.Recordset oRsInterchange.Open "Interchange", oConn, adOpenDynamic, adLockOptimistic 'The GroupIndex table stores information for each Group received. Set oRsGroup = New ADODB.Recordset oRsGroup.Open "FunctionalGroup", oConn, adOpenDynamic, adLockOptimistic 'The TS810_Header table stores information of the Transaction Sets Area1 and Area 3 Set oRs810Header = New ADODB.Recordset oRs810Header.Open "TS810_Header", oConn, adOpenDynamic, adLockOptimistic 'The TS810_Detail table stores information of the Transaction Set in Area2 Set oRs810Detail = New ADODB.Recordset oRs810Detail.Open "TS810_Detail", oConn, adOpenDynamic, adLockOptimistic sSefFile = "810_004010.EVAL0.SEF" sEdiFile = "810_sample.x12" Set oEdiDoc = New Fredi.ediDocument ' The FORWARD-ONLY cursor increases the performance of processing the EDI ' document (see Technical Note 2). oEdiDoc.CursorType = Cursor_ForwardOnly '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.LoadEdi sPath & sEdiFile 'Gets the first data segment of the EDI file Set oSegment = oEdiDoc.FirstDataSegment ' Loop that will traverse through the EDI document from top to bottom. This ' is required for FORWARD-ONLY cursor. Do While Not oSegment Is Nothing ' Data segments are uniquely identified by their segment Identifier (ID). ' The loop section and the area (or table) properties of the data segment ' are read for each iteration of the loop. sSegmentID = oSegment.ID sLoopSection = oSegment.LoopSection nArea = oSegment.Area If nArea = 0 Then ' Data segments that are not designated an area (i.e. area = 0) are control ' segments that are part of the Interchange or Functional Group envelopes, ' and are not part of the Transaction Set. If sSegmentID = "ISA" Then oRsInterchange.AddNew oRsInterchange("ISA01_AuthorizationInformationQualifier").Value = oSegment.DataElementValue(1) ' Authorization Information Qualifier (I01) oRsInterchange("ISA02_AuthorizationInformation").Value = oSegment.DataElementValue(2) ' Authorization Information (I02) oRsInterchange("ISA03_SecurityInformationQualifier").Value = oSegment.DataElementValue(3) ' Security Information Qualifier (I03) oRsInterchange("ISA04_SecurityInformation").Value = oSegment.DataElementValue(4) ' Security Information (I04) oRsInterchange("ISA05_InterchangeIdQualifier").Value = oSegment.DataElementValue(5) ' Interchange ID Qualifier (I05) oRsInterchange("ISA06_InterchangeSenderId").Value = oSegment.DataElementValue(6) ' Interchange Sender ID (I06) oRsInterchange("ISA07_InterchangeIdQualifier").Value = oSegment.DataElementValue(7) ' Interchange ID Qualifier (I05) oRsInterchange("ISA08_InterchangeReceiverId").Value = oSegment.DataElementValue(8) ' Interchange Receiver ID (I07) oRsInterchange("ISA09_InterchangeDate").Value = oSegment.DataElementValue(9) ' Interchange Date (I08) oRsInterchange("ISA10_InterchangeTime").Value = oSegment.DataElementValue(10) ' Interchange Time (I09) oRsInterchange("ISA11_InterchangeControlStandardsIdentifier").Value = oSegment.DataElementValue(11) ' Interchange Control Standards Identifier (I10) oRsInterchange("ISA12_InterchangeControlVersionNumber").Value = oSegment.DataElementValue(12) ' Interchange Control Version Number (I11) oRsInterchange("ISA13_InterchangeControlNumber").Value = oSegment.DataElementValue(13) ' Interchange Control Number (I12) oRsInterchange("ISA14_AcknowledgmentRequested").Value = oSegment.DataElementValue(14) ' Acknowledgment Requested (I13) oRsInterchange("ISA15_UsageIndicator").Value = oSegment.DataElementValue(15) ' Usage Indicator (I14) oRsInterchange("ISA16_ComponentElementSeparator").Value = oSegment.DataElementValue(16) ' Component Element Separator (I15) oRsInterchange.Update nInterKey = oRsInterchange("InterKey").Value ElseIf sSegmentID = "IEA" Then sValue = oSegment.DataElementValue(1) ' Number of Included Functional Groups (I16) sValue = oSegment.DataElementValue(2) ' Interchange Control Number (I12) ElseIf sSegmentID = "GS" Then oRsGroup.AddNew oRsGroup("InterKey").Value = nInterKey oRsGroup("GS01_FunctionalIdentifierCode").Value = oSegment.DataElementValue(1) ' Functional Identifier Code (479) oRsGroup("GS02_ApplicationSendersCode").Value = oSegment.DataElementValue(2) ' Application Sender's Code (142) oRsGroup("GS03_ApplicationReceiversCode").Value = oSegment.DataElementValue(3) ' Application Receiver's Code (124) oRsGroup("GS04_Date").Value = oSegment.DataElementValue(4) ' Date (373) oRsGroup("GS05_Time").Value = oSegment.DataElementValue(5) ' Time (337) oRsGroup("GS06_GroupControlNumber").Value = oSegment.DataElementValue(6) ' Group Control Number (28) oRsGroup("GS07_ResponsibleAgencyCode").Value = oSegment.DataElementValue(7) ' Responsible Agency Code (455) oRsGroup("GS08_VersionReleaseIndustryIdentifierCode").Value = oSegment.DataElementValue(8) ' Version / Release / Industry Identifier Code (480) oRsGroup.Update nGroupKey = oRsGroup("GroupKey").Value ElseIf sSegmentID = "GE" Then sValue = oSegment.DataElementValue(1) ' Number of Transaction Sets Included (97) sValue = oSegment.DataElementValue(2) ' Group Control Number (28) End If ' sSegmentID = "GE" ElseIf nArea = 1 Then ' Data segments in area 1 are processed here. If sLoopSection = "" Then If sSegmentID = "ST" Then ' Transaction Set Header oRs810Header.AddNew oRs810Header("GroupKey").Value = nGroupKey oRs810Header("ST01_TransactionSetIdentifierCode").Value = oSegment.DataElementValue(1) ' Transaction Set Identifier Code (143) oRs810Header("ST02_TransactionSetControlNumber").Value = oSegment.DataElementValue(2) ' Transaction Set Control Number (329) oRs810Header.Update nHeaderKey = oRs810Header("HeaderKey").Value ElseIf sSegmentID = "BIG" Then ' Beginning Segment for Invoice oRs810Header("BIG01_Date").Value = oSegment.DataElementValue(1) ' Date (373) oRs810Header("BIG02_InvoiceNumber").Value = oSegment.DataElementValue(2) ' Invoice Number (76) oRs810Header("BIG04_PurchaseOrderNumber").Value = oSegment.DataElementValue(4) ' Purchase Order Number (324) oRs810Header("BIG07_TransactionTypeCode").Value = oSegment.DataElementValue(7) ' Transaction Type Code (640) oRs810Header.Update ElseIf sSegmentID = "CUR" Then ' Currency oRs810Header("CUR01_EntityIdentifierCode").Value = oSegment.DataElementValue(1) ' Entity Identifier Code (98) oRs810Header("CUR02_CurrencyCode").Value = oSegment.DataElementValue(2) ' Currency Code (100) oRs810Header.Update ElseIf sSegmentID = "REF" Then ' Reference Identification ' Reference Identification Qualifier (128) oRs810Header("REF02_VendorID_Number").Value = oSegment.DataElementValue(2) ' Reference Identification (127) oRs810Header.Update ElseIf sSegmentID = "ITD" Then ' Terms of Sale/Deferred Terms of Sale oRs810Header("ITD01_TermsTypeCode").Value = oSegment.DataElementValue(1) ' Terms Type Code (336) oRs810Header("ITD02_TermsBasisDateCode").Value = oSegment.DataElementValue(2) ' Terms Basis Date Code (333) oRs810Header("ITD03_TermsDiscountPercent").Value = oSegment.DataElementValue(3) ' Terms Discount Percent (338) oRs810Header("ITD04_TermsDiscountDueDate").Value = oSegment.DataElementValue(4) ' Terms Discount Due Date (370) oRs810Header("ITD05_TermsDiscountDaysDue").Value = oSegment.DataElementValue(5) ' Terms Discount Days Due (351) oRs810Header("ITD06_TermsNetDueDate").Value = oSegment.DataElementValue(6) ' Terms Net Due Date (446) oRs810Header("ITD07_TermsNetDays").Value = oSegment.DataElementValue(7) ' Terms Net Days (386) oRs810Header("ITD08_TermsDiscountAmount").Value = oSegment.DataElementValue(8) ' Terms Discount Amount (362) oRs810Header("ITD12_Description").Value = oSegment.DataElementValue(12) ' Description (352) oRs810Header("ITD13_DayOfMonth").Value = oSegment.DataElementValue(13) ' Day of Month (765) oRs810Header.Update ElseIf sSegmentID = "DTM" Then ' Date/Time Reference ' Date/Time Qualifier (374) oRs810Header("DTM02_ShippedDate").Value = oSegment.DataElementValue(2) ' Date (373) oRs810Header.Update End If ' sSegmentID ElseIf sLoopSection = "N1" Then If sSegmentID = "N1" Then ' Name sN1Entity = oSegment.DataElementValue(1) ' Entity Identifier Code (98) If sN1Entity = "ST" Then oRs810Header("N102_ShipToName").Value = oSegment.DataElementValue(2) ' Name (93) oRs810Header.Update ElseIf sN1Entity = "BT" Then oRs810Header("N102_BillToName").Value = oSegment.DataElementValue(2) ' Name (93) oRs810Header.Update ElseIf sN1Entity = "OB" Then oRs810Header("N102_OrderedByName").Value = oSegment.DataElementValue(2) ' Name (93) oRs810Header.Update End If End If ' sSegmentID = "DMG" End If ' sLoopSection = "N1" ElseIf nArea = 2 Then ' Data segments in area 2 are processed here. If sLoopSection = "IT1" Then If sSegmentID = "IT1" Then ' Baseline Item Data (Invoice) oRs810Detail.AddNew oRs810Detail("HeaderKey").Value = nHeaderKey oRs810Detail("IT101_AssignedIdentification").Value = oSegment.DataElementValue(1) ' Assigned Identification (350) oRs810Detail("IT102_QuantityInvoiced").Value = oSegment.DataElementValue(2) ' Quantity Invoiced (358) oRs810Detail("IT103_UnitOrBasisForMeasurementCode").Value = oSegment.DataElementValue(3) ' Unit or Basis for Measurement Code (355) oRs810Detail("IT104_UnitPrice").Value = oSegment.DataElementValue(4) ' Unit Price (212) oRs810Detail("IT107_SKU_Number").Value = oSegment.DataElementValue(7) ' Product/Service ID (234) oRs810Detail("IT109_VendorPartNumber").Value = oSegment.DataElementValue(9) ' Product/Service ID (234) oRs810Detail.Update End If ' sSegmentID ElseIf sLoopSection = "IT1;PID" Then If sSegmentID = "PID" Then ' Product/Item Description oRs810Detail("PID05_Description").Value = oSegment.DataElementValue(5) ' Description (352) oRs810Detail.Update End If ' sSegmentID End If ' sLoopSection = "IT1;PID" ElseIf nArea = 3 Then ' Data segments in area 3 are processed here. If sLoopSection = "" Then If sSegmentID = "TDS" Then ' Total Monetary Value Summary oRs810Header("TDS01_GrossInvoiceAmount").Value = oSegment.DataElementValue(1) ' Amount (610) oRs810Header("TDS02_GrossAmountApplicableDiscount").Value = oSegment.DataElementValue(2) ' Amount (610) oRs810Header("TDS03_NetInvoiceAmount").Value = oSegment.DataElementValue(3) ' Amount (610) oRs810Header.Update ElseIf sSegmentID = "CAD" Then ' Carrier Detail oRs810Header("CAD01_TransportationMethodTypeCode").Value = oSegment.DataElementValue(1) ' Transportation Method/Type Code (91) oRs810Header("CAD02_EquipmentInitial").Value = oSegment.DataElementValue(2) ' Equipment Initial (206) oRs810Header("CAD03_EquipmentNumber").Value = oSegment.DataElementValue(3) ' Equipment Number (207) oRs810Header("CAD04_StandardCarrierAlphaCode").Value = oSegment.DataElementValue(4) ' Standard Carrier Alpha Code (140) oRs810Header("CAD05_Routing").Value = oSegment.DataElementValue(5) ' Routing (387) oRs810Header.Update ElseIf sSegmentID = "CTT" Then ' Transaction Totals oRs810Header("CTT01_NumberOfLineItems").Value = oSegment.DataElementValue(1) ' Number of Line Items (354) oRs810Header.Update ElseIf sSegmentID = "SE" Then ' Transaction Set Trailer End If ' sSegmentID = "SE" ElseIf sLoopSection = "SAC" Then If sSegmentID = "SAC" Then ' Service, Promotion, Allowance, or Charge Information oRs810Header("SAC01_AllowanceOrChargeIndicator").Value = oSegment.DataElementValue(1) ' Allowance or Charge Indicator (248) oRs810Header("SAC02_ServicePromotionAllowanceOrChargeCode").Value = oSegment.DataElementValue(2) ' Service, Promotion, Allowance, or Charge Code (1300) oRs810Header("SAC05_Amount").Value = oSegment.DataElementValue(5) ' Amount (610) oRs810Header.Update End If End If ' sLoopSection = "SAC" End If ' nArea = 3 ' Get the next data segment in the document. Set oSegment = oSegment.Next Loop ' Not oSegment Is Nothing MsgBox ("Done") oConn.Close End Sub