Wechsel auf Office 365

Public Function fDelFolder(sPath$)
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")  
    On Error Resume Next
    objFSO.DeleteFolder (sPath)
    Set objFSO = Nothing
End Function

Public Function XMLDateiLesen(ByVal XmlDateiMitPfad As String) As Boolean

Dim xmlDoc As New MSXML2.DOMDocument
Dim xmlNodeList As IXMLDOMNodeList
Dim x As IXMLDOMNode
Dim xmlKnoten As IXMLDOMNode

Dim Zeile%
Dim Spalte%
Dim i%

'BSe  
Dim BaseStr As String
Dim BaseStrLen As Integer
Dim NumberPos As Integer
Dim myBildkennung As String
Dim myDinKlasse As String
'BSe  

xmlDoc.async = False 'Parser gibt die Steuerung erst dann an den Code zurueck, wenn das Dokument vollstaendig bearbeitet ist und fuer die Bearbeitung bereit ist  

xmlDoc.validateOnParse = False

xmlDoc.SetProperty "SelectionLanguage", "XPath"       ' Suchen erfolgt mittels XPath  


If xmlDoc.Load(XmlDateiMitPfad) Then
Else
    MsgBox "XML nicht geladen!" & vbCrLf & vbCrLf & xmlDoc.parseError.reason & vbCrLf & xmlDoc.parseError.srcText  
    XMLDateiLesen = False
    
    Exit Function
End If
Zeile = 2
Spalte = 0

Application.Workbooks.Add 'hier wird die Excel Datei ge?ffnet (SML)  
Cells.Select
Selection.NumberFormat = "@"  

Range("A1").Select  
With Application.ActiveCell
    ' Liste ALLER <Main-Data>-Knoten durchlaufen  
    Set xmlNodeList = xmlDoc.SelectNodes("/Tool-Data/Tool/Main-Data")  
    For Each x In xmlNodeList
       .Offset(1, 1).Value = "Kundenwerkzeugnummer"  
       ' wenn Kundensachnummer gef?llt, dann ok, wenn nicht globale Variable nutzen  
       If x.SelectSingleNode("ID21002").Text <> "" Then  
           'ist Kundensachnummer aus STY, dann formatieren, wenn nicht lassen  
           If Mid(x.SelectSingleNode("ID21002").Text, 1, 2) = "1-" Then  
                .Offset(5, 1).Value = gZFMatNR ' Wert von Hauptmaske uebernehmen  
             Else
                .Offset(5, 1).Value = x.SelectSingleNode("ID21002").Text ' Wert uebernehmen  
           End If
         Else
         .Offset(5, 1).Value = gZFMatNR ' Wert von Hauptmaske uebernehmen  
       End If
       .Offset(1, 0).Value = "Lieferant"  
       .Offset(5, 0).Value = x.SelectSingleNode("Supplier").Text     ' Wert uebernehmen  
    Next
    i = 2
      Set xmlNodeList = xmlDoc.SelectNodes("/Tool-Data/Tool/Category/Category-Data")  
      For Each x In xmlNodeList                            ' Liste ALLER <Category-Data>-Knoten durchlaufen  
         .Offset(1, i).Value = x.SelectSingleNode("PropertyName").Text ' Wert uebernehmen  
         .Offset(5, i).Value = x.SelectSingleNode("Value").Text  ' Wert uebernehmen  
         'BSe  
         Select Case x.SelectSingleNode("PropertyName").Text  
            Case "BLD"  
                myBildkennung = CStr(Replace(x.SelectSingleNode("Value").Text, ",", ".")) ' Wert uebernehmen  
            Case "NSM"  
                myDinKlasse = CStr(Replace(x.SelectSingleNode("Value").Text, ",", ".")) ' Wert uebernehmen  
                myDinKlasse = Replace(myDinKlasse, "DIN", "")  
         End Select
         'BSe  
         i = i + 1
      Next
      Spalte = i
      Set xmlNodeList = xmlDoc.SelectNodes("/Tool-Data/Tool/Properties/Property-Data") ' Liste ALLER <Property-Data>-Knoten erstellen  
      For Each x In xmlNodeList                            ' Liste ALLER <Property-Data>-Knoten durchlaufen  
         'BSe  
         BaseStr = Trim(x.SelectSingleNode("PropertyName").Text) ' Wert uebernehmen  
         BaseStrLen = Len(BaseStr) + 1
         If (isNumberinStr(BaseStr)) Then
            NumberPos = 0
            NumberPos = isNumberpos(BaseStr)
            'MsgBox "Neues Format: " & Mid(BaseStr, 1, NumberPos - 1) & "_" & Mid(BaseStr, NumberPos, BaseStrLen - NumberPos)  
            BaseStr = Mid(BaseStr, 1, NumberPos - 1) & "_" & Mid(BaseStr, NumberPos, BaseStrLen - NumberPos)  
         End If

         '.Offset(1, Spalte).Value = X.SelectSingleNode("PropertyName").text ' Wert uebernehmen  
         '.Offset(1, I).Value = X.SelectSingleNode("PropertyName").text ' Wert uebernehmen  
         .Offset(1, Spalte).Value = BaseStr
         'BSe  

         '.Offset(1, Spalte).Value = X.SelectSingleNode("PropertyName").text ' Wert uebernehmen  
'         Debug.Print X.SelectSingleNode("PropertyName").text  
         'Debug.Print Replace(X.SelectSingleNode("Value").text, ",", ".")  
         .Offset(5, Spalte).Value = CStr(x.SelectSingleNode("Value").Text)  
         '.Offset(5, Spalte).Value = CStr(Replace(X.SelectSingleNode("Value").Text, ",", "."))   ' Wert uebernehmen'27.01.17 auskommentiert  
         Spalte = Spalte + 1 ' Naechste freie Zeile fuer naechsten Durchlauf  
      Next
   End With
   'BSe  
   Cells(1, 1) = "hugo"  
   'MsgBox "Din-Klasse: " & myDinKlasse & "  Bildkennung: " & myBildkennung  
   '"\\emea\frd\team\kstZ1099\individual\OQPF\FDO-Klassenimport\Mapping-listen\Zuweisung_Norm_zu_Axalantklassen_durch_BLD\Zuweisung DIN 4000-81 zu Axalant.xls"  
   
   'Cells(1, 1) = getAxalantClass(myDinKlasse, myBildkennung)  
   'auskommentiert. Damit wird keine Klasse eingetragen!!!!!!! 13.02.17  
   
   'BSe  

    
   Call SaveAsCSV(gMsFileName & gDateitypSMLaktuell, gMsSMLNichtEingelesenPath)
   ActiveWorkbook.Close savechanges:=False
   'hier wird die Excel Datei geschlossen(SML)