Prikazi cijelu temu 11.07.2013 18:21
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: Spajanje arhiviranih baza
Evo samo na pocetku u konstanti promijeni putanu da tvojih baza:
PreuzmiIzvorni kôd (Visual Basic):
  1. Const DirPutanja = "D:\Internet\obrada\_TempBaza\Baze\"
  2. Function KreirajTemp()
  3. Dim wrk As Workspace
  4. Dim Db As Database, tmpBaza As Database
  5. Dim Rs As Recordset, tmpRs As Recordset
  6. Dim OrgTabela As TableDef, TmpTabela As TableDef
  7. Dim ImeBaze As String, ImeTmpBaze As String
  8. Dim ImeFajla As String, SQL As String
  9. Dim Prefiks As Integer
  10.  
  11.  
  12.  
  13. DoCmd.SetWarnings False
  14. ImeTmpBaze = Db_Putanja & "tmp.mdb"
  15. If Dir(ImeTmpBaze) <> "" Then Kill ImeTmpBaze
  16. Set Db = CurrentDb()
  17. Set wrk = DBEngine.Workspaces(0)
  18. 'Tabela transakcije
  19. Set tmpBaza = wrk.CreateDatabase(ImeTmpBaze, dbLangGeneral)
  20. Set OrgTabela = Db.TableDefs("tblTransakcije")
  21. Set TmpTabela = tmpBaza.CreateTableDef("tblTransakcije")
  22. For Each fld In OrgTabela.Fields
  23.     With TmpTabela
  24.     .Fields.Append .CreateField(fld.Name, fld.Type, fld.Size)
  25.     End With
  26. Next fld
  27. tmpBaza.TableDefs.Append TmpTabela
  28.            
  29. ImeFajla = Dir(DirPutanja, vbDirectory)
  30.         Do While Len(ImeFajla) > 0
  31.             ImeFajla = Dir
  32.              If Len(ImeFajla) > 2 Then
  33.              ImeBaze = DirPutanja & ImeFajla
  34.              Prefiks = Mid(ImeBaze, (Len(ImeBaze) - 8), 2)
  35.                 SQL = "INSERT INTO tblTransakcije (IDTransakcije, Datum, Skladiste, IDdokumenta, BrDokumenta, " _
  36.                & "PartnerID, RadniNalog, OperID, StatusTR, DatumU, Brisanje )IN '" & ImeTmpBaze _
  37.                & "' SELECT " & Prefiks & "& [IDTransakcije] AS ID, Datum, Skladiste,IDdokumenta, " _
  38.                & "BrDokumenta,PartnerID, RadniNalog, OperID, StatusTR,DatumU, Brisanje " _
  39.                & "FROM tblTransakcije IN '" & ImeBaze & "';"
  40.                DoCmd.RunSQL (SQL)
  41.              End If
  42.         Loop
  43. Set OrgTabela = Nothing
  44. Set TmpTabela = Nothing
  45. 'tabela ulazizlaz
  46. Set OrgTabela = Db.TableDefs("tblUlazIzlaz")
  47. Set TmpTabela = tmpBaza.CreateTableDef("tblUlazIzlaz")
  48. For Each fld In OrgTabela.Fields
  49.     With TmpTabela
  50.     .Fields.Append .CreateField(fld.Name, fld.Type, fld.Size)
  51.     End With
  52. Next fld
  53. tmpBaza.TableDefs.Append TmpTabela
  54. ImeFajla = Dir(DirPutanja, vbDirectory)
  55.         Do While Len(ImeFajla) > 0
  56.             ImeFajla = Dir
  57.              If Len(ImeFajla) > 2 Then
  58.              ImeBaze = DirPutanja & ImeFajla
  59.              Prefiks = Mid(ImeBaze, (Len(ImeBaze) - 8), 2)
  60.                 SQL = "INSERT INTO tblUlazIzlaz ( IDTransakcije, Sifra, Ulaz, Izlaz, Status, DatumU )IN '" & ImeTmpBaze _
  61.                    & "' SELECT " & Prefiks & " & [IDTransakcije] AS ID, Sifra, Ulaz, Izlaz, Status, DatumU " _
  62.                    & "FROM tblUlazIzlaz IN '" & ImeBaze & "';"
  63.                DoCmd.RunSQL (SQL)
  64.              End If
  65.         Loop
  66. Set OrgTabela = Nothing
  67. Set TmpTabela = Nothing
  68. Set tmpBaza = Nothing
  69. Set Db = Nothing
  70. DoCmd.SetWarnings True
  71. End Function
  72. Function Db_Putanja() As String
  73.  '------------------------------------------------
  74. 'Ova funkcija pronalazi putanju postojee baze
  75. 'Autor funkcije ZXZ
  76. '-------------------------------------------------
  77.    Dim Db As Database, Putanja As String
  78.    
  79.     On Error Resume Next
  80.     Set Db = DBEngine(0)(0)
  81.     Putanja = Db.Name
  82.     Do Until Right$(Putanja, 1) = "\"
  83.         Putanja = Left$(Putanja, Len(Putanja) - 1)
  84.     Loop
  85.  
  86.     Db_Putanja = Putanja
  87. End Function
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.