Const DirPutanja = "D:\Internet\obrada\_TempBaza\Baze\"

Function KreirajTemp()

Dim wrk As Workspace

Dim Db As Database, tmpBaza As Database

Dim Rs As Recordset, tmpRs As Recordset

Dim OrgTabela As TableDef, TmpTabela As TableDef

Dim ImeBaze As String, ImeTmpBaze As String

Dim ImeFajla As String, SQL As String

Dim Prefiks As Integer

 

 

 

DoCmd.SetWarnings False

ImeTmpBaze = Db_Putanja & "tmp.mdb"

If Dir(ImeTmpBaze) <> "" Then Kill ImeTmpBaze

Set Db = CurrentDb()

Set wrk = DBEngine.Workspaces(0)

Set tmpBaza = wrk.CreateDatabase(ImeTmpBaze, dbLangGeneral)

Set OrgTabela = Db.TableDefs("tblTransakcije")

Set TmpTabela = tmpBaza.CreateTableDef("tblTransakcije")

For Each fld In OrgTabela.Fields

    With TmpTabela

    .Fields.Append .CreateField(fld.Name, fld.Type, fld.Size)

    End With

Next fld

tmpBaza.TableDefs.Append TmpTabela

           

ImeFajla = Dir(DirPutanja, vbDirectory)

        Do While Len(ImeFajla) > 0

            ImeFajla = Dir

             If Len(ImeFajla) > 2 Then

             ImeBaze = DirPutanja & ImeFajla

             Prefiks = Mid(ImeBaze, (Len(ImeBaze) - 8), 2)

                SQL = "INSERT INTO tblTransakcije (IDTransakcije, Datum, Skladiste, IDdokumenta, BrDokumenta, " _

               & "PartnerID, RadniNalog, OperID, StatusTR, DatumU, Brisanje )IN '" & ImeTmpBaze _

               & "' SELECT " & Prefiks & "& [IDTransakcije] AS ID, Datum, Skladiste,IDdokumenta, " _

               & "BrDokumenta,PartnerID, RadniNalog, OperID, StatusTR,DatumU, Brisanje " _

               & "FROM tblTransakcije IN '" & ImeBaze & "';"

               DoCmd.RunSQL (SQL)

             End If

        Loop

Set OrgTabela = Nothing

Set TmpTabela = Nothing

Set OrgTabela = Db.TableDefs("tblUlazIzlaz")

Set TmpTabela = tmpBaza.CreateTableDef("tblUlazIzlaz")

For Each fld In OrgTabela.Fields

    With TmpTabela

    .Fields.Append .CreateField(fld.Name, fld.Type, fld.Size)

    End With

Next fld

tmpBaza.TableDefs.Append TmpTabela

ImeFajla = Dir(DirPutanja, vbDirectory)

        Do While Len(ImeFajla) > 0

            ImeFajla = Dir

             If Len(ImeFajla) > 2 Then

             ImeBaze = DirPutanja & ImeFajla

             Prefiks = Mid(ImeBaze, (Len(ImeBaze) - 8), 2)

                SQL = "INSERT INTO tblUlazIzlaz ( IDTransakcije, Sifra, Ulaz, Izlaz, Status, DatumU )IN '" & ImeTmpBaze _

                   & "' SELECT " & Prefiks & " & [IDTransakcije] AS ID, Sifra, Ulaz, Izlaz, Status, DatumU " _

                   & "FROM tblUlazIzlaz IN '" & ImeBaze & "';"

               DoCmd.RunSQL (SQL)

             End If

        Loop

Set OrgTabela = Nothing

Set TmpTabela = Nothing

Set tmpBaza = Nothing

Set Db = Nothing

DoCmd.SetWarnings True

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

    Set Db = DBEngine(0)(0)

    Putanja = Db.Name

    Do Until Right$(Putanja, 1) = "\"

        Putanja = Left$(Putanja, Len(Putanja) - 1)

    Loop

 

    Db_Putanja = Putanja

End Function