Sub xmlimport()
On Error Resume Next
Dim xmlDom As New MSXML2.DOMDocument
Dim xmlrow As MSXML2.IXMLDOMNode
Dim xmlcol As MSXML2.IXMLDOMNode
Dim xmlaa As MSXML2.IXMLDOMNode
Dim rs As New ADODB.Recordset
Dim i, k, x, t As Integer
Dim policekod As Long
 
xmlDom.Load Me.kaynak_dosya.Value 'dosyayı yüklüyoruz..
 
rs.Open "POLİÇE", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.AddNew
 
For Each xmlrow In xmlDom.documentElement.ChildNodes
 
For i = 0 To rs.Fields.Count - 1  ' alan adlarına göre kayıtlar yerleştiriliyor..
If rs(i).Name = xmlrow.nodeName Then
If xmlrow.nodeName = "PoliçeNumarası" Then policekod = xmlrow.Text 'poliçe numarasını alınıyor
   rs(i) = xmlrow.Text
   rs.Update
End If
Next
Next
 
Dim rsm As New ADODB.Recordset
Dim rsa As New ADODB.Recordset
Dim rsarc As New ADODB.Recordset
rsm.Open "MÜŞTERİ", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rsa.Open "ADRESİ", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rsarc.Open "ARAÇ", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rsm.AddNew
rsa.AddNew
rsarc.AddNew
 
For Each xmlrow In xmlDom.documentElement.ChildNodes
 
For Each xmlcol In xmlrow.ChildNodes
 
    If xmlrow.nodeName = "MÜŞTERİ" Then
 
        For k = 0 To rsm.Fields.Count - 1
 
        If k = 0 Then rsm(0) = policekod
        If rsm(k).Name = xmlcol.nodeName Then
            rsm(k) = xmlcol.Text
            rsm.Update
        End If
 
        Next
 
 
        For Each xmlaa In xmlcol.ChildNodes
 
        If xmlcol.nodeName = "ADRESİ" Then
        For x = 0 To rsa.Fields.Count - 1
        If x = 0 Then rsa(0) = policekod
        If rsa(x).Name = xmlaa.nodeName Then
            rsa(x) = xmlaa.Text
            rsa.Update
        End If
 
        Next x
        End If
        Next xmlaa
 
 
    End If
 
 
    If xmlcol.nodeName = "ARAÇ" Then
 
        For Each xmlaa In xmlcol.ChildNodes
        Debug.Print xmlaa.nodeName, "=", xmlaa.Text
        For t = 0 To rsarc.Fields.Count - 1
        If t = 0 Then rsarc(0) = policekod
        If rsarc(t).Name = xmlaa.nodeName Then
            rsarc(t) = xmlaa.Text
            rsarc.Update
        End If
 
        Next t
 
 
        Next
    End If
 
 
 
 
Next xmlcol
Next xmlrow
 
rs.Close
rsm.Close
rsa.Close
stDocName = "ANADOLUSOR"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
 
    CurrentDb.Execute "DELETE * FROM [POLİÇE] "
    Kill Me.kaynak_dosya
 
    stDocName = "CariTransfer"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
    CurrentDb.Execute "DELETE * FROM [TRANSFER] "
MsgBox "Anadolusigorta Verileri Yüklenmiştir."
 
End Sub