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
Portal
iCentar
Statistike
Procitajte pravila
Donacije
Racunari i oprema
Softver i op. sistemi
Hardver i mreze
Programiranje i baze
Nauka
Tehnika
Dom i porodica
Biznis
Sport i rekreacija
Zabava
Zanimljivosti
Pretrazi
Tim
Registriraj se
Vazni alati
Razno. veze Aktivne teme ... Vijesti (RSS, ...)
Prijavi se
Verzija za stampu