also ein Beispiel
Dim binFeldRfm() As Byte
Dim binFeldRes() As Byte
Dim Datei As String
Dim dbconnect As New ADODB.Connection
Dim Einheit As String
Dim exportKurve As Byte
Dim MaxRfm As Double
Dim MinRes As Integer
Dim MaxRes As Integer
Dim Messstelle As String
Dim oDOMex As DOMDocument
Dim oElem01 As IXMLDOMElement
Dim oElem02 As IXMLDOMElement
Dim oElem03 As IXMLDOMElement
Dim oInstruct As IXMLDOMProcessingInstruction
Dim i As Integer
Dim ii As Integer
Dim iii As Integer
Dim RFM() As Double
Dim Res() As Integer
Dim rstKle As ADODB.Recordset
Dim SQLgetKle As String
Dim Zeile As String
' ----------------------------------------------------------------------------
If dbconnect.State = adStateClosed Then dbconnect.Open cn
Zeile = InputBox("Welche KurvenNummer soll exportiert werden ?", "Export-Rainflow", 1)
If Zeile = "" Then Exit Sub
exportKurve = CByte(Zeile)
' --> Instanzieren des DOMObjektes
Set oDOMex = New DOMDocument
' --> Hier schreiben wir die Processing Instruktionen in das Xml Dokument
' --> Dort wird die XML Version und die Codierung des Dokumentes festgelegt
Set oInstruct = oDOMex.createProcessingInstruction("xml", "version=""1.0""" & strISO & " standalone=""yes""")
oDOMex.preserveWhiteSpace = True
Call oDOMex.insertBefore(oInstruct, oDOMex.childNodes.item(0))
' --> Hier erstellen wir das Rootelement welches die Datenelement aufnehmen wird
Set oElem01 = oDOMex.createElement("LMSDTXMLFORMAT")
' --> Anfügen des Root Elementes an das Dokument
oDOMex.appendChild oElem01
Set oElem02 = oDOMex.createElement("VERSION")
oElem01.appendChild oElem02
oElem02.Text = "1.0"
Set oElem02 = oDOMex.createElement("ENTITYCOUNT")
oElem01.appendChild oElem02
oElem02.Text = 1 'Val(lblAuftrag(6))
'für die Headerdaten
SQLgetKle = "SELECT * from mwaergebnis..r_kle join r_mes on mwaergebnis..r_kle.mesid = r_mes.mes_id join R_mwp on r_mes.mwaprnr = r_mwp.mwaprnr where Kle_id = " & frmPlotparaDB.tblPlotPara.TextMatrix(1, 2)
Set rstKle = New ADODB.Recordset
rstKle.CursorType = adOpenKeyset
rstKle.LockType = adLockOptimistic
rstKle.MaxRecords = 1
rstKle.Open SQLgetKle, dbconnect, , , adCmdText
Set oElem02 = oDOMex.createElement("HEADER")
oElem01.appendChild oElem02
Set oElem03 = oDOMex.createElement("VERSUCHSNUMMER")
oElem02.appendChild oElem03
oElem03.Text = Trim$(CheckNull(rstKle!versnr))
i = exportKurve
Set oNodes = oDOM.selectNodes("/KollektivBatchPlot/M" & Format$(Val(lblAuftrag(2)), "000") & "/P" & Format$(i, "000") & "/M")
If oNodes.item(0).nodeTypedValue <> "" Then
Messstelle = oNodes.item(0).nodeTypedValue
End If
Set oNodes = oDOM.selectNodes("/KollektivBatchPlot/M" & Format$(Val(lblAuftrag(2)), "000") & "/Para/Einheit")
If oNodes.item(0).nodeTypedValue <> "" Then
Einheit = oNodes.item(0).nodeTypedValue
End If
Set oElem02 = oDOMex.createElement("RAINFLOWMATRIX")
oElem01.appendChild oElem02
oElem02.setAttribute "ID", Messstelle
SQLgetKle = "SELECT * from mwaergebnis..r_kle where Kle_id = " & frmPlotparaDB.tblPlotPara.TextMatrix(i, 2)
Set rstKle = New ADODB.Recordset
rstKle.CursorType = adOpenKeyset
rstKle.LockType = adLockOptimistic
rstKle.MaxRecords = 1
rstKle.Open SQLgetKle, dbconnect, , , adCmdText
binFeldRfm() = rstKle!Kollektiv
binFeldRes() = rstKle!Residuum
ReDim RFM(64, 64)
ReDim Res(127)
ro.LiesRFMDB binFeldRfm, binFeldRes, RFM(), Res
MaxRfm = 0
Zeile = ""
For ii = 1 To 64
For iii = 1 To 64
Zeile = Zeile + CStr(RFM(ii, iii)) + " "
If RFM(ii, iii) > MaxRfm Then MaxRfm = RFM(ii, iii)
Next
Next
Set oElem03 = oDOMex.createElement("RFM")
oElem02.appendChild oElem03
oElem03.Text = Zeile
oElem03.setAttribute "valuecount", 4096
MaxRes = 0
MinRes = 64
Zeile = ""
For ii = 1 To UBound(Res())
If Res(ii) = 0 Then Exit For
Zeile = Zeile + CStr(Res(ii)) + " "
If Res(ii) > MaxRes Then MaxRes = Res(ii)
If Res(ii) < MinRes Then MinRes = Res(ii)
Next
Set oElem03 = oDOMex.createElement("RES")
oElem02.appendChild oElem03
oElem03.Text = Zeile
oElem03.setAttribute "valuecount", UBound(Res())
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "START"
oElem03.setAttribute "type", "float"
Zeile = Format$(0, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "DELTA"
oElem03.setAttribute "type", "float"
Zeile = Format$(1, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "FLAG"
oElem03.setAttribute "type", "long"
oElem03.setAttribute "value", 1
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "UNIT.RFM"
oElem03.setAttribute "type", "string"
oElem03.setAttribute "value", Einheit
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "MATRIXTYP"
oElem03.setAttribute "type", "long"
oElem03.setAttribute "value", 2
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "FILTER"
oElem03.setAttribute "type", "float"
Zeile = Format$(1, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "KLASSZAHL"
oElem03.setAttribute "type", "long"
oElem03.setAttribute "value", 64
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "UNGRENZE"
oElem03.setAttribute "type", "float"
Zeile = Format$(-rstKle!klb, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "OBGRENZE"
oElem03.setAttribute "type", "float"
Zeile = Format$(rstKle!klb, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "ABANFANG"
oElem03.setAttribute "type", "float"
Zeile = Format$(0, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "ABLAENGE"
oElem03.setAttribute "type", "float"
Zeile = Format$(1, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "ABNAME"
oElem03.setAttribute "type", "string"
oElem03.setAttribute "value", ""
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "UNIT.RES"
oElem03.setAttribute "type", "string"
oElem03.setAttribute "value", Einheit
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "RESLAENGE"
oElem03.setAttribute "type", "long"
oElem03.setAttribute "value", UBound(Res())
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "MINIMUM.RFM"
oElem03.setAttribute "type", "float"
Zeile = Format$(0, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "MAXIMUM.RFM"
oElem03.setAttribute "type", "float"
Zeile = Format$(MaxRfm, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "MINIMUM.RES"
oElem03.setAttribute "type", "float"
Zeile = Format$(MinRes, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
Set oElem03 = oDOMex.createElement("attribute")
oElem02.appendChild oElem03
oElem03.setAttribute "name", "MAXIMUM.RES"
oElem03.setAttribute "type", "float"
Zeile = Format$(MaxRes, "0.00000000e+000")
so.ReplaceTextString Zeile, ",", "."
oElem03.setAttribute "value", Zeile
rstKle.Close
Set rstKle = Nothing
Datei = KollektivExportPath & frmPlotparaDB.tblPlotPara.TextMatrix(i, 1) & "_" & frmPlotparaDB.tblPlotPara.TextMatrix(i, 2) & "_" & frmPlotparaDB.tblPlotPara.TextMatrix(i, 7) & "_" & frmPlotparaDB.tblPlotPara.TextMatrix(i, 6) & ".erfm"
so.ReplaceTextString Datei, Chr$(34), "_"
oDOMex.Save Datei
If dbconnect.State = adStateOpen Then dbconnect.Close
MsgBox Datei & " wurde erstellt!"
Da müsste jetzt für jedes Tag wie Version, Entitycount , ........ je ein Zeileumbruch crlf kommen.
Übelster Trick wäre der, den XML-File nach schreiben über ein Textkonverter zu schicken, der dann die Zeilenumbrüche einfügt, wie gesagt übel.