XML Output auf WEBDAV Verzeichnis

  • VB.NET

    XML Output auf WEBDAV Verzeichnis

    hallo alle zusammen,
    habe ein excel makro vorliegen,das mir ein vorliegende excel tabelle in eine xml datei exportiert und auf einem definierten share platziert (im Beispiel C:\lokal\) ... ich würd nun gerne die entstehende xml datei auf einem https webdav verzeichnis ablegen. pfad, user, pw sind bekannt ... wie kann ich dies am besten realisieren? bin scho leider seit langem raus aus der vb scene und würde mich über unterstützung freuen! vielen dank im voraus

    VB XML Makro

    VB.NET-Quellcode

    1. Option Explicit
    2. Sub XML_Export()
    3. Dim strSpaltenName
    4. strSpaltenName = ""
    6. Dim oSheet As Worksheet
    7. Set oSheet = Application.ActiveSheet
    8. ' Spaltenanzahl ermitteln
    9. Dim intCol
    10. intCol = 1
    11. Do Until Cells(1, intCol) = ""
    12. intCol = intCol + 1
    13. Loop
    14. intCol = intCol - 1
    15. 'MsgBox "Habe " & intCol & " Spalten gefunden...."
    16. ' Neue Datei schreiben, wenn Spaltenanzahl > 0
    17. If intCol > 0 Then
    18. Dim strFileName As String
    19. strFileName = "C:\Lokal\"
    20. strFileName = strFileName + oSheet.Name + "_" + CStr(Date)
    21. strFileName = strFileName + ".xml"
    23. ' Alte Datei löschen
    24. If Dir(strFileName) > "" Then Kill strFileName
    26. Open strFileName For Output As #1
    28. Dim intRow As Integer
    29. intRow = 2
    30. Dim x
    32. Print #1, "<?xml version=""1.0"" encoding=""iso-8859-1""?>"
    33. Print #1, MakeStartTag("Ergebnismenge")
    35. Do Until Cells(intRow, 1) = ""
    36. Print #1, vbTab & MakeStartTag(oSheet.Name)
    37. For x = 2 To intCol '2, weil Index in Spalte 1 ausgeblendet werden soll
    38. strSpaltenName = ReplaceSpecialChar(CStr(Cells(1, x).Value))
    39. Print #1, vbTab & vbTab & MakeStartTag(strSpaltenName) & FormatCell(Cells(intRow, x)) & MakeEndTag(strSpaltenName)
    40. Next
    41. intRow = intRow + 1
    42. Print #1, vbTab & MakeEndTag(oSheet.Name)
    43. Loop
    45. Print #1, MakeEndTag("Ergebnismenge")
    46. Close #1
    47. If intRow - 2 = 1 Then
    48. MsgBox "In die Datei '" & strFileName & "' wurde " & intRow - 2 & " Datensatz geschrieben!"
    49. Else
    50. MsgBox "In die Datei '" & strFileName & "' wurden " & intRow - 2 & " Datensätze geschrieben!"
    51. End If
    52. End If
    53. End Sub
    55. Function MakeStartTag(ByVal Text As String) As String
    56. MakeStartTag = "<" & Text & ">"
    57. End Function
    58. Function MakeEndTag(ByVal Text As String) As String
    59. MakeEndTag = "</" & Text & ">"
    60. End Function
    62. Function FormatCell(oCell As Range)
    63. If IsDate(oCell.Value) Then
    64. FormatCell = Format(oCell.Value, "yyyy-mm-dd\Thh:mm:ss")
    65. Exit Function
    66. End If
    67. 'If IsNumeric(oCell.Value) Then
    68. ' FormatCell = Replace(CStr(oCell.Value), ",", ".")
    69. ' Exit Function
    70. ' End If
    71. If InStr(1, oCell.Value, "&") Then
    72. FormatCell = Replace(CStr(oCell.Value), "&", "_x0026_")
    73. Exit Function
    74. End If
    75. FormatCell = oCell.Value
    76. End Function
    78. Function ReplaceSpecialChar(ByVal strText As String) As String
    79. If InStr(1, strText, " ") Then
    80. strText = Replace(strText, " ", "_x0020_")
    81. End If
    82. If InStr(1, strText, "&") Then
    83. strText = Replace(strText, "&", "_x0026_")
    84. End If
    85. ReplaceSpecialChar = strText
    86. End Function


    dies habe ich gefunden, wie binde ich es am besten ein (soll denn upload einer lokalen datei auf ein webdav verzeichnis realisieren):

    VB.NET-Quellcode

    1. Dim objRecord As New adodb.Record
    2. Dim objStream As New adodb.Stream
    4. sFilename = sFileToUpload
    6. objRecord.Open sFilename, "URL=" & sDAVFolder, adModeReadWrite, adCreateOverwrite, , sUserName, sPassword
    8. objStream.Open objRecord, adModeReadWrite, adOpenStreamFromRecord
    10. objStream.Type = adTypeBinary
    12. objStream.LoadFromFile sFileToUpload
    14. objStream.Flush