Prikazi cijelu temu 16.07.2013 10:18
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: Spajanje arhiviranih baza
Evo pa istestiraj.
PreuzmiIzvorni kôd (Visual Basic):
  1. Function KreirajTemp()
  2. Dim wrk As Workspace
  3. Dim Db As Database, tmpBaza As Database
  4. Dim Rs As Recordset, tmpRs As Recordset
  5. Dim Fld As Field
  6. Dim OrgTabela As TableDef, TmpTabela As TableDef
  7. Dim ImeBaze As String, ImeTmpBaze As String
  8. Dim ImeFajla As String, SQL(2) As String
  9. Dim Prefiks As Integer, God As Integer
  10. Dim PrefiksS As String
  11.  
  12.  
  13.  
  14. DoCmd.SetWarnings False
  15. ImeTmpBaze = Db_Putanja & "tmp.mdb"
  16. If Dir(ImeTmpBaze) <> "" Then Kill ImeTmpBaze
  17. Set Db = CurrentDb()
  18. Set wrk = DBEngine.Workspaces(0)
  19. 'Provjera:
  20. God = Format(Date, "yy")
  21. ImeFajla = Dir(DirPutanja, vbDirectory)
  22.     Do While Len(ImeFajla) > 0
  23.         ImeFajla = Dir
  24.         If Right(ImeFajla, 3) = "Mdb" Then
  25.             Prefiks = Mid(ImeFajla, (Len(ImeFajla) - 8), 2)
  26.             If Prefiks < God Then: God = Prefiks
  27.         End If
  28.     Loop
  29. 'Tabela transakcije
  30. Set tmpBaza = wrk.CreateDatabase(ImeTmpBaze, dbLangGeneral)
  31. Set OrgTabela = Db.TableDefs("tblTransakcije")
  32. Set TmpTabela = tmpBaza.CreateTableDef("tblTransakcije")
  33. For Each Fld In OrgTabela.Fields
  34.     With TmpTabela
  35.     .Fields.Append .CreateField(Fld.Name, Fld.Type, Fld.Size)
  36.     End With
  37. Next Fld
  38. tmpBaza.TableDefs.Append TmpTabela
  39. Set OrgTabela = Nothing
  40. Set TmpTabela = Nothing
  41. 'tabela ulazizlaz
  42. Set OrgTabela = Db.TableDefs("tblUlazIzlaz")
  43. Set TmpTabela = tmpBaza.CreateTableDef("tblUlazIzlaz")
  44. For Each Fld In OrgTabela.Fields
  45.     With TmpTabela
  46.     .Fields.Append .CreateField(Fld.Name, Fld.Type, Fld.Size)
  47.     End With
  48. Next Fld
  49. tmpBaza.TableDefs.Append TmpTabela
  50. Set OrgTabela = Nothing
  51. Set TmpTabela = Nothing
  52. 'Prenos podataka
  53. ImeFajla = Dir(DirPutanja, vbDirectory)
  54.         Do While Len(ImeFajla) > 0
  55.             ImeFajla = Dir
  56.              If Right(ImeFajla, 3) = "Mdb" Then
  57.                 ImeBaze = DirPutanja & ImeFajla
  58.                 Prefiks = Mid(ImeBaze, (Len(ImeBaze) - 8), 2)
  59.                 PrefiksS = Format(Prefiks, "00")
  60.                 If Prefiks = God Then
  61.                 SQL(0) = "WHERE IDTransakcije<>1"
  62.                 Else
  63.                 SQL(0) = ""
  64.                 End If
  65.                      SQL(1) = "INSERT INTO tblTransakcije (IDTransakcije, Datum, Skladiste, IDdokumenta, BrDokumenta, " _
  66.                     & "PartnerID, RadniNalog, OperID, StatusTR, DatumU, Brisanje )IN '" & ImeTmpBaze _
  67.                     & "' SELECT " & PrefiksS & "& [IDTransakcije] AS ID, Datum, Skladiste,IDdokumenta, " _
  68.                     & "BrDokumenta,PartnerID, RadniNalog, OperID, StatusTR,DatumU, Brisanje " _
  69.                     & "FROM tblTransakcije IN '" & ImeBaze & "' " & SQL(0)
  70.                     DoCmd.RunSQL (SQL(1))
  71.                     SQL(2) = "INSERT INTO tblUlazIzlaz ( IDTransakcije, Sifra, Ulaz, Izlaz, Status, DatumU )IN '" & ImeTmpBaze _
  72.                         & "' SELECT " & PrefiksS & " & [IDTransakcije] AS ID, Sifra, Ulaz, Izlaz, Status, DatumU " _
  73.                         & "FROM tblUlazIzlaz IN '" & ImeBaze & "' " & SQL(0)
  74.                     DoCmd.RunSQL (SQL(2))
  75.                      
  76.              End If
  77.         Loop
  78. Set tmpBaza = Nothing
  79. Set Db = Nothing
  80. DoCmd.SetWarnings True
  81. End Function
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.