Private Sub cmdGenerate_Click() Dim oEdiDoc As Fredi.ediDocument Dim oSchema As Fredi.ediSchema Dim oSchemas As Fredi.ediSchemas Dim oInterchange As Fredi.ediInterchange Dim oGroup As Fredi.ediGroup Dim oTransactionset As Fredi.ediTransactionSet Dim oSegment As Fredi.ediDataSegment Dim sSefFile As String Dim sEdiFile As String Dim sPath As String sPath = Application.ActiveWorkbook.Path & "\" sSefFile = "CODECO_D95B.EVAL0.SEF" 'EVALUATION SEF FILE sEdiFile = "CODECO_D99B.edi" 'CREATES OEDIDOC OBJECT Set oEdiDoc = New Fredi.ediDocument 'THIS MAKES CERTAIN THAT FREDI ONLY USES THE SEF FILE PROVIDED, AND THAT IT DOES 'NOT USE ITS BUILT-IN STANDARD REFERENCE TABLE TO GENERATE THE EDI FILE. Set oSchemas = oEdiDoc.GetSchemas oSchemas.EnableStandardReference = False 'ENABLES FORWARD WRITE, AND INCREASES BUFFER I/O TO IMPROVE PERFORMANCE oEdiDoc.CursorType = Cursor_ForwardWrite oEdiDoc.Property(Property_DocumentBufferIO) = 200 'LOADS THE SEF FILE Set oSchema = oEdiDoc.LoadSchema(sPath & sSefFile, 0) 'SET TERMINATORS oEdiDoc.SegmentTerminator = "'{13:10}" oEdiDoc.ElementTerminator = "+" oEdiDoc.CompositeTerminator = ":" oEdiDoc.ReleaseIndicator = "?" 'CREATES THE UNB SEGMENT Set oInterchange = oEdiDoc.CreateInterchange("UN", "D95B") Set oSegment = oInterchange.GetDataSegmentHeader() oSegment.DataElementValue(1, 1) = "UNOA" 'Syntax identifier oSegment.DataElementValue(1, 2) = "2" 'Syntax version number oSegment.DataElementValue(2, 1) = "SNDRID12345" 'Interchange sender identification oSegment.DataElementValue(3, 1) = "COMPANYABCD" 'Recipient identification oSegment.DataElementValue(4, 1) = "081216" 'Date oSegment.DataElementValue(4, 2) = "0919" 'Time oSegment.DataElementValue(5, 0) = Cells(4, "C") 'Interchange control reference 'CREATES THE UNH SEGMENT Set oTransactionset = oInterchange.CreateTransactionSet("CODECO") Set oSegment = oTransactionset.GetDataSegmentHeader() oSegment.DataElementValue(1, 0) = Cells(5, "C") 'Message reference number oSegment.DataElementValue(2, 1) = "CODECO" 'Message type identifier oSegment.DataElementValue(2, 2) = "D" 'Message version number oSegment.DataElementValue(2, 3) = "95B" 'Message release number oSegment.DataElementValue(2, 4) = "UN" 'Controlling agency 'BGM - BEGINNING OF MESSAGE Set oSegment = oTransactionset.CreateDataSegment("BGM") oSegment.DataElementValue(1, 1) = "34" 'Document/message name, coded oSegment.DataElementValue(2, 0) = Cells(6, "C") 'Document/message number oSegment.DataElementValue(3, 0) = "9" 'Message function, coded 'NAD - NAME AND ADDRESS Set oSegment = oTransactionset.CreateDataSegment("NAD\\NAD") oSegment.DataElementValue(1, 0) = "MS" 'Party qualifier oSegment.DataElementValue(2, 1) = Cells(7, "C") 'Party identification oSegment.DataElementValue(2, 2) = "160" 'Code list qualifier oSegment.DataElementValue(2, 3) = "87" 'Code list responsible agency, coded 'NAD - NAME AND ADDRESS Set oSegment = oTransactionset.CreateDataSegment("NAD(2)\\NAD") oSegment.DataElementValue(1, 0) = "MR" 'Party qualifier oSegment.DataElementValue(2, 1) = Cells(8, "C") 'Party identification oSegment.DataElementValue(2, 2) = "160" 'Code list qualifier oSegment.DataElementValue(2, 3) = "87" 'Code list responsible agency, coded 'NAD - NAME AND ADDRESS Set oSegment = oTransactionset.CreateDataSegment("NAD(3)\\NAD") oSegment.DataElementValue(1, 0) = "CA" 'Party qualifier oSegment.DataElementValue(2, 1) = Cells(9, "C") 'Party identification oSegment.DataElementValue(2, 2) = "160" 'Code list qualifier oSegment.DataElementValue(2, 3) = "20" 'Code list responsible agency, coded 'GID - GOODS ITEM DETAILS Set oSegment = oTransactionset.CreateDataSegment("GID\\GID") oSegment.DataElementValue(1, 0) = Cells(10, "C") 'Goods item number 'MEA - MEASUREMENTS Set oSegment = oTransactionset.CreateDataSegment("GID\\MEA") oSegment.DataElementValue(1, 0) = "AAE" 'Measurement purpose qualifier oSegment.DataElementValue(2, 1) = "G" 'Property measured, coded oSegment.DataElementValue(3, 1) = "KGM" 'Measure unit qualifier oSegment.DataElementValue(3, 2) = Cells(12, "C") 'Measurement value 'EQD - EQUIPMENT DETAILS Set oSegment = oTransactionset.CreateDataSegment("EQD\\EQD") oSegment.DataElementValue(1, 0) = Cells(13, "C") 'Equipment qualifier oSegment.DataElementValue(2, 1) = Cells(14, "C") 'Equipment identification number oSegment.DataElementValue(3, 1) = "22" 'Equipment size and type identification oSegment.DataElementValue(3, 2) = "102" 'Code list qualifier oSegment.DataElementValue(3, 3) = "5" 'Code list responsible agency, coded oSegment.DataElementValue(5, 0) = "1" 'Equipment status, coded oSegment.DataElementValue(6, 0) = "5" 'Full/empty indicator, coded 'RFF - REFERENCE Set oSegment = oTransactionset.CreateDataSegment("EQD\\RFF") oSegment.DataElementValue(1, 1) = "CN" 'Reference qualifier oSegment.DataElementValue(1, 2) = Cells(15, "C") 'Reference number 'DTM - DATE/TIME/PERIOD Set oSegment = oTransactionset.CreateDataSegment("EQD\\DTM") oSegment.DataElementValue(1, 1) = "7" 'Date/time/period qualifier oSegment.DataElementValue(1, 2) = Cells(16, "C") 'Date/time/period oSegment.DataElementValue(1, 3) = "203" 'Date/time/period format qualifier 'LOC - PLACE/LOCATION IDENTIFICATION Set oSegment = oTransactionset.CreateDataSegment("EQD\\LOC") oSegment.DataElementValue(1, 0) = Cells(17, "C") 'Place/location qualifier oSegment.DataElementValue(2, 1) = Cells(18, "C") 'Place/location identification oSegment.DataElementValue(2, 2) = "139" 'Code list qualifier oSegment.DataElementValue(2, 3) = "6" 'Code list responsible agency, coded 'MEA - MEASUREMENTS Set oSegment = oTransactionset.CreateDataSegment("EQD\\MEA") oSegment.DataElementValue(1, 0) = "AAE" 'Measurement purpose qualifier oSegment.DataElementValue(2, 1) = "G" 'Property measured, coded oSegment.DataElementValue(3, 1) = "KGM" 'Measure unit qualifier oSegment.DataElementValue(3, 2) = "15000" 'Measurement value 'SEL - SEAL NUMBER Set oSegment = oTransactionset.CreateDataSegment("EQD\\SEL") oSegment.DataElementValue(1, 0) = Cells(19, "C") 'Seal number oSegment.DataElementValue(2, 1) = "CA" 'Sealing party, coded 'TDT - TRANSPORT INFORMATION Set oSegment = oTransactionset.CreateDataSegment("EQD\\TDT\\TDT") oSegment.DataElementValue(1, 0) = "1" 'Transport stage qualifier oSegment.DataElementValue(2, 0) = Cells(20, "C") 'Conveyance reference number oSegment.DataElementValue(3, 1) = "2" 'Mode of transport, coded oSegment.DataElementValue(4, 1) = "25" 'Type of means of transport identification oSegment.DataElementValue(5, 1) = "RCH" 'Carrier identification oSegment.DataElementValue(5, 2) = "172" 'Code list qualifier oSegment.DataElementValue(5, 3) = "87" 'Code list responsible agency, coded oSegment.DataElementValue(5, 4) = "RCH" 'Carrier name oSegment.DataElementValue(8, 1) = "JMK765439" 'Id. of means of transport identification oSegment.DataElementValue(8, 2) = "146" 'Code list qualifier oSegment.DataElementValue(8, 3) = "ZZZ" 'Code list responsible agency, coded 'LOC - PLACE/LOCATION IDENTIFICATION Set oSegment = oTransactionset.CreateDataSegment("EQD\\TDT\\LOC") oSegment.DataElementValue(1, 0) = "16" 'Place/location qualifier oSegment.DataElementValue(2, 1) = Cells(21, "C") 'Place/location identification oSegment.DataElementValue(2, 2) = "139" 'Code list qualifier oSegment.DataElementValue(2, 3) = "6" 'Code list responsible agency, coded oSegment.DataElementValue(3, 1) = "RTW" 'Related place/location one identification oSegment.DataElementValue(3, 2) = "128" 'Code list qualifier oSegment.DataElementValue(3, 3) = "ZZZ" 'Code list responsible agency, coded 'NAD - NAME AND ADDRESS Set oSegment = oTransactionset.CreateDataSegment("EQD\\NAD") oSegment.DataElementValue(1, 0) = "CF" 'Party qualifier oSegment.DataElementValue(2, 1) = "GHT3456" 'Party identification oSegment.DataElementValue(2, 2) = "160" 'Code list qualifier oSegment.DataElementValue(2, 3) = "20" 'Code list responsible agency, coded 'CNT - CONTROL TOTAL Set oSegment = oTransactionset.CreateDataSegment("CNT") oSegment.DataElementValue(1, 1) = "16" 'Control qualifier oSegment.DataElementValue(1, 2) = "1" 'Control value 'TRAILING SEGMENTS ARE AUTOMATICALLY CREATED WHEN FREDI COMMITS (SAVES) THE EDIDOC OBJECT INTO A FILE. oEdiDoc.Save sPath & sEdiFile 'display edi string MsgBox oEdiDoc.GetEdiString 'DESTROYS OBJECTS Set oSegment = Nothing Set oTransactionset = Nothing Set oGroup = Nothing Set oSchema = Nothing Set oInterchange = Nothing Set oEdiDoc = Nothing End Sub
