Option Compare Database
Option Explicit
Const Putanja = "c:\_Forum\Obrada\bbb.txt" ' putanja do fajla
Dim Db As Database
Dim Rs As Recordset
Dim tdf As TableDef
Dim fld As Field
Function ImportXML()
Dim ImeTabele As String, temp As String
Dim Poz As Integer, I As Integer

ImeTabele = "program"
I = 1
Set Db = CurrentDb
Close #1
Open Putanja For Input As 1
While Not EOF(1)
Line Input #1, temp
Poz = InStr(1, temp, ImeTabele)
 If Poz > 0 Then
  If ImeTabele = "<tabela" Or ImeTabele = "podaci godina" Then
  ImeTabele = temp
  End If
  Call PripremiTabelu(ImeTabele)
  If I < 4 Then
  I = I + 1
  End If
  ImeTabele = Choose(I, "program", "subjekt", "podaci godina", "<tabela")
 End If
Wend
Close #1
End Function

Private Sub PripremiTabelu(ImeT)
Dim Podatak As String, Tabela As String
Dim I As Integer, Poz(2) As Integer

Poz(0) = InStr(1, ImeT, "tabela")
Poz(1) = InStr(1, ImeT, "podaci godina")
    If Poz(0) > 0 Then
        Poz(1) = InStr(1, ImeT, "=") + 2
        Poz(2) = InStr(1, ImeT, ">") - 1
        Tabela = Mid(ImeT, Poz(1), Poz(2) - Poz(1))
        ImeT = "tabela"
        Set tdf = Db.CreateTableDef(Tabela)
        Set fld = tdf.CreateField("ID", dbText, 6)
        tdf.Fields.Append fld
    ElseIf Poz(1) > 0 Then
        Dim Podatak2 As String
        Poz(0) = InStr(1, ImeT, "godina=") + 8
        Poz(1) = InStr(1, ImeT, "period=") - 2
        Poz(2) = InStr(1, ImeT, ">") - 11
        Podatak = Mid(ImeT, Poz(0), Poz(1) - Poz(0))
        Podatak2 = Mid(ImeT, Poz(1) + 10, Poz(2) - Poz(1))
        ImeT = "podaci godina"
        Set tdf = Db.CreateTableDef(ImeT)
        Set fld = tdf.CreateField("ID", dbText, 6)
        tdf.Fields.Append fld
    Else
        Set tdf = Db.CreateTableDef(ImeT)
        Set fld = tdf.CreateField("ID", dbLong)
        fld.Attributes = dbAutoIncrField
        tdf.Fields.Append fld
    End If
    On Error Resume Next
    Db.TableDefs.Append tdf
    If Err.Number = 3010 Then
    Err.Clear
    On Error GoTo 0
    DoCmd.DeleteObject acTable, tdf.Name
    Db.TableDefs.Append tdf
    ElseIf Err.Number > 0 Then
    MsgBox "Došlo je do greške"
    End
    End If

Select Case ImeT

Case "Program"
tdf.Fields.Append tdf.CreateField("Verzija", dbText, 50)
Podatak = UcitajP
Set Rs = Db.OpenRecordset(ImeT)
Rs.AddNew
Rs.Fields(1) = Podatak
Rs.Update
Rs.Close
Set tdf = Nothing
Case "Subjekt"
tdf.Fields.Append tdf.CreateField("id_broj", dbText, 13)
tdf.Fields.Append tdf.CreateField("cert_racunovodja", dbText, 20)
tdf.Fields.Append tdf.CreateField("cert_rac_lic", dbText, 15)
tdf.Fields.Append tdf.CreateField("email", dbText, 50)
tdf.Fields.Append tdf.CreateField("pvelicina", dbText, 15)
tdf.Fields.Append tdf.CreateField("velicina", dbText, 15)
Set Rs = Db.OpenRecordset(ImeT)
Rs.AddNew
For I = 1 To 6
Podatak = UcitajP
If Trim(Podatak) <> "" Then
Rs.Fields(I) = Podatak
End If
Next I
Rs.Update
Rs.Close
Case "podaci godina"
tdf.Fields.Append tdf.CreateField("godina", dbText, 4)
tdf.Fields.Append tdf.CreateField("period", dbText, 20)
Set Rs = Db.OpenRecordset(ImeT)
Rs.AddNew
Rs.Fields(1) = Podatak
Rs.Fields(2) = Podatak2
Rs.Update
Rs.Close
Case "Tabela"
Dim Naziv As String, Podatak1 As String, temp As String
Dim Nazivi As String
If Tabela = "promjene_u_kapitalu" Then
tdf.Fields.Append tdf.CreateField("DK", dbSingle)
tdf.Fields.Append tdf.CreateField("RR", dbSingle)
tdf.Fields.Append tdf.CreateField("ND", dbSingle)
tdf.Fields.Append tdf.CreateField("OR", dbSingle)
tdf.Fields.Append tdf.CreateField("AND", dbSingle)
tdf.Fields.Append tdf.CreateField("U", dbSingle)
tdf.Fields.Append tdf.CreateField("MI", dbSingle)
tdf.Fields.Append tdf.CreateField("UK", dbSingle)
Else
tdf.Fields.Append tdf.CreateField("bruto", dbSingle)
tdf.Fields.Append tdf.CreateField("ispravka", dbSingle)
tdf.Fields.Append tdf.CreateField("tekuca_godina", dbSingle)
tdf.Fields.Append tdf.CreateField("prosla_godina", dbSingle)
End If
Set Rs = Db.OpenRecordset(Tabela)
Line Input #1, temp
Nazivi = ""
Rs.AddNew
Do While InStr(1, temp, "</tabela") = 0
Nazivi = Nazivi & Naziv
UpisPod temp, Naziv, Podatak, Podatak1
If InStr(1, Nazivi, Naziv) > 0 Then
Rs.Update
Rs.AddNew
Nazivi = ""
End If
Rs.Fields(0) = Val(Podatak)
Rs(Naziv) = Val(Podatak1)
Line Input #1, temp
Loop
Rs.Close
End Select

End Sub

Private Sub UpisPod(temp, Naziv, Podatak, Podatak1)
Dim Poz(4) As Integer
Poz(0) = InStr(1, temp, "aop id=") + 8
Poz(1) = InStr(1, temp, "kolona=") - 2
Poz(2) = InStr(1, temp, "kolona=") + 8
Poz(3) = InStr(1, temp, ">") - 1
Poz(4) = InStr(1, temp, "</")
Podatak = Mid(temp, Poz(0), Poz(1) - Poz(0))
Naziv = Mid(temp, Poz(2), Poz(3) - Poz(2))
Podatak1 = Mid(temp, Poz(3) + 2, Poz(4) - Poz(3) - 2)
End Sub
Function UcitajP() As String
Dim temp As String
Dim Poz(1) As Integer

Line Input #1, temp
Poz(0) = InStr(1, temp, ">") + 1
Poz(1) = InStr(1, temp, "</")
UcitajP = Mid(temp, Poz(0), Poz(1) - Poz(0))
End Function