Option Compare Database
Option Explicit
Function KreirajPolje(ImeTabele As String, ImePolja As String, TipPolja As Integer, _
Optional Velicina As Integer, Optional Defolt)
Dim Db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
'............................................
'Tip polja
'1-jes/No
'2-Number(Byte)
'3-Number(Integer)
'4-Number(Long Integer)
'5-Currency
'6-Number(Single)
'7-Number(Double)
'8-Date/Time
'9-Binary
'10-Text
'11-OLE Object
'12-Memo
'.............................................
Set Db = CurrentDb()
Set tdf = Db.TableDefs(ImeTabele)
Set fld = tdf.CreateField(ImePolja, TipPolja, Velicina)
tdf.Fields.Append fld

Set tdf = Nothing
Set fld = Nothing
Set Db = Nothing
End Function
Function KreirajTabelu(ImeTabele As String)

Dim Db As DAO.Database
Dim fld As DAO.Field
Dim tdf As DAO.TableDef
 
Set Db = CurrentDb
For Each tdf In Db.TableDefs
If tdf.Name = ImeTabele Then
DoCmd.DeleteObject acTable, ImeTabele
End If
Next tdf

Set Db = CurrentDb
Set tdf = Db.CreateTableDef(ImeTabele)
Set fld = tdf.CreateField("ID", dbLong)
fld.Attributes = dbAutoIncrField
    With tdf.Fields
        .Append fld
        .Refresh
    End With
Db.TableDefs.Append tdf
    Set fld = Nothing
    Set tdf = Nothing
    Set Db = Nothing
End Function
Function ImportCSV(ImeCsv As String)
Dim Db As DAO.Database
Dim Rs0 As DAO.Recordset, Rs1 As DAO.Recordset
Dim Putanja As String, SQL(1) As String, temp(1) As String, tmp(1) As String, ImePolja() As String
Dim I As Integer, Poz(3) As Integer, Broj As Integer, BrojPolja As Integer


 Set Db = CurrentDb
 Putanja = Db_Putanja
 KreirajTabelu "Prva"
 KreirajPolje "Prva", "Red4", 3
 KreirajPolje "Prva", "Red5", 3
 KreirajTabelu "Druga"
 SQL(0) = "SELECT * FROM Prva"
 SQL(1) = "SELECT * FROM Druga"
 Close #1
 Open Putanja & ImeCsv For Input As 1
While Not EOF(1)
    If I = 5 Then
    Set Rs1 = Db.OpenRecordset(SQL(1))
    End If
    Poz(1) = 1
    Poz(0) = 1
    Poz(2) = 1
    Poz(3) = 1
    BrojPolja = 0
    I = I + 1
    
 Line Input #1, temp(0)
 temp(0) = temp(0) & ";"
 
    If I = 4 Then
     Set Rs0 = Db.OpenRecordset(SQL(0))
     Line Input #1, temp(1)
     temp(1) = temp(1) & ";"
       Do While Len(temp(0)) <> Poz(1)
       Poz(1) = InStr(Poz(0), temp(0), ";")
       tmp(0) = Mid(temp(0), Poz(0), Poz(1) - Poz(0))
       Poz(3) = InStr(Poz(2), temp(1), ";")
       tmp(1) = Mid(temp(1), Poz(2), Poz(3) - Poz(2))
            If tmp(0) <> "" Then
            Broj = Val(tmp(0))
                 If Broj > 0 Then
                   Rs0.AddNew
                   Rs0.Fields(1) = tmp(0)
                   Rs0.Fields(2) = tmp(1)
                   Rs0.Update
                 End If
            End If
       Poz(0) = Poz(1) + 1
       Poz(2) = Poz(3) + 1
       Loop
       Rs0.Close
    ElseIf I = 5 Then
        Do While Len(temp(0)) <> Poz(1)
        Poz(1) = InStr(Poz(0), temp(0), ";")
        tmp(0) = Mid(temp(0), Poz(0), Poz(1) - Poz(0))
        BrojPolja = BrojPolja + 1
        tmp(0) = tmp(0) & BrojPolja
        ReDim Preserve ImePolja(BrojPolja)
        ImePolja(BrojPolja) = tmp(0)
        KreirajPolje "Druga", tmp(0), 10, 25
        Poz(0) = Poz(1) + 1
        Loop
    ElseIf I > 5 Then
        If Left(temp(0), 30) = String(30, ";") Then GoTo Kraj
        Rs1.AddNew
        Do While Len(temp(0)) <> Poz(1)
        BrojPolja = BrojPolja + 1
        Poz(1) = InStr(Poz(0), temp(0), ";")
        tmp(0) = Mid(temp(0), Poz(0), Poz(1) - Poz(0))
        If tmp(0) <> "" Then
        Rs1(ImePolja(BrojPolja)) = tmp(0)
        End If
        Poz(0) = Poz(1) + 1
        Loop
        Rs1.Update
    End If
    
Wend
Kraj:
 Rs1.Close
 Set Db = Nothing
End Function

Function Db_Putanja() As String
 '--------------------------------------------------------------------------------------
 'Ova funkcija pronalazi putanju postojee baze
 'Autor funkcije ZXZ
'__________________________________________________
    Dim Db As Database, Putanja As String
    
    On Error Resume Next                                     'Ako naieš na grešku nastavi
    Set Db = DBEngine(0)(0)                                  'Setovanje baze
    Putanja = Db.Name                                          'Upis putanje baze i njenog imena
    Do Until Right$(Putanja, 1) = "\"                         'Petlja za odvajanje imena baze od putanje baze
        Putanja = Left$(Putanja, Len(Putanja) - 1)
    Loop

    Db_Putanja = Putanja                                      'Upis putanje u funkciju
End Function

                Print #2, temp
           End If
         Else
           Print #2, temp
         End If
    Else
     Print #2, temp
    End If
Wend
     Close #1
     Close #2
Set Db = Nothing
End Function