Kapalı XML Dosyasından İstenilen Tag'lardaki Verileri

[yerbakili]

Merhaba, çeşitli yöntemlerle (kapalı xml/txt dosyası üzerinde işlem yapma) çözüm bulmaya çalıştım ancak kısmen çözüm bulabildim. Hernekadar aşağıdaki yöntemle documentproperties.xml dosyasındaki "uyapdogrulamakodu" tagındaki "RWVQrpnE" yazan veriye erişebildiysem de, content.xml dosyasınının en altında yer alan satırdaki "webID id" tagındaki "yPtkjWI - tVXOiWW - I3/hHgc - azi24o=" şeklindeki veriye erişemiyorum. Birçok farklı yöntem denedim ancak content.xml dosyasındaki yapının karışık olmasından dolayı başarılı olamadım.

Yardımcı olabilirseniz çok sevinirim.

documentproperties.xml dosyasındaki "uyapdogrulamakodu" tagındaki bilgiyi bu kodla alabiliyorum.

Dim Rky As Object, ayır() As String, i As Integer
    Set Rky = CreateObject("MSXML2.DOMDocument")
    Rky.async = False
    If Rky.Load(Environ("TEMP") & "\" & dosyaadi & "\documentproperties.xml") Then
        ayır = Split(Rky.Text, " ")
        For i = 0 To UBound(ayır)
        If i = 0 And Len(ayır(i)) = 8 Then lbluyapdoğrulamakodu.Caption = ayır(i) 'UYAP DOĞRULAMA KODU
        Next i
    End If

 

[Asri]

Bu şekilde deneyin.
Aranan ve sonkarakter leri değiştirerek farklı bilgileri de alabilir siniz.

Sub xml_parcala()
    dosya = ActiveWorkbook.Path & "\content.xml"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(dosya).OpenAsTextStream(1, -2)    
    veri = ts.readall

  [B]  aranan = "<webID id="""
    sonkarakter = """"[/B]

    basla = InStr(veri, aranan)
    If basla > 0 Then
       veri = Mid(veri, basla + Len(aranan) + 1, Len(veri))
      [B] webidstr [/B]= Mid(veri, 1, InStr(veri, sonkarakter) - 1)
    End If
    ts.Close
    
    dosya = ActiveWorkbook.Path & "\documentproperties.xml"
    Set ts = fso.GetFile(dosya).OpenAsTextStream(1, -2)
    veri = ts.readall

[B]    aranan = "<entry key=""uyapdogrulamakodu"">"
    sonkarakter = "<"[/B]

    basla = InStr(veri, aranan)
    If basla > 0 Then
       veri = Mid(veri, basla + Len(aranan) + 1, Len(veri))
       [B]dogrulamastr[/B] = Mid(veri, 1, InStr(veri, sonkarakter) - 1)
    End If
    ts.Close
    
    Set ts = Nothing
    Set fso = Nothing
    
End Sub

 

[Asri]

Parça alma işlemini fonksiyona çevirdim. Bu şekilde daha kullanışlı olacaktır.

Sub kullanimi()
    veri = bilgial(ActiveWorkbook.Path & "\content.xml", "<webID id=""", """")
End Sub

Function bilgial(dosyastr, arananstr, sonkarakterstr) As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(dosyastr).OpenAsTextStream(1, -2)
    
    veri = ts.readall
    basla = InStr(veri, arananstr)
    If basla > 0 Then
       veri = Mid(veri, basla + Len(arananstr) + 1, Len(veri))
       bilgial = Mid(veri, 1, InStr(veri, sonkarakterstr) - 1)
    End If
    ts.Close
    
    Set ts = Nothing
    Set fso = Nothing    
  End Function

Ayrıca dosyadan değil de bir metin değişkeninden parça almak için aşağıdaki fonksiyon da kullanılabilir.

Function bilgial(veristr, arananstr, sonkarakterstr) As String
    basla = InStr(veristr, arananstr)
    If basla > 0 Then
       veristr = Mid(veristr, basla + Len(arananstr), Len(veristr))
       bilgial = Mid(veristr, 1, InStr(veristr, sonkarakterstr) - 1)
    End If
End Function

 

[yerbakili]

@asri hocam, elinize emeğinize sağlık. Çok daha pratik bir şekilde, istediğim verilere artık erişebiliyorum. Allah razı olsun.

 

[Haluk]

Merhaba;

Aslında veriyi aradığınız dosya XML dosyası olduğu için, XML özelliklerini kullanarak söz konusu veriyi aşağıdaki kodla daha rahat bir şekilde alabilirsiniz.

Sub Test()
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    MyFile = Application.GetOpenFilename
    If MyFile = "False" Then Exit Sub
    
    xDoc.Load MyFile
    Set MyAttribute = xDoc.SelectNodes("//template/webID")
    MsgBox MyAttribute(0).getAttribute("id")
End Sub

 

[Haluk]

İlave olarak;

Uyap ile ilgiler bilgilerle ilgili olarak, diğer XML dosyasındaki verileri okumak için;

Sub Test2()
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    MyFile = Application.GetOpenFilename
    If MyFile = "False" Then Exit Sub
    
    xDoc.Load MyFile
    
    Set MyAttribute = xDoc.SelectNodes("//properties/entry")
    Entry1 = MyAttribute(0).getAttribute("key")
    Entry2 = MyAttribute(1).getAttribute("key")
    
    Set Mykey = xDoc.SelectSingleNode("//properties/entry[0]")
    Key1 = Mykey.Text
    
    Set Mykey = xDoc.SelectSingleNode("//properties/entry[1]")
    Key2 = Mykey.Text
    
    MsgBox Entry1 & "= " & Key1 & vbCrLf & Entry2 & "= " & Key2
End Sub

Böylece, VBA'de XML kullanımına ilişkin olarak güzel bir örnek de hazırlamış olduk.


.