iCentar

20.01.2014 19:12

pmiroslav

Clan

Registrovan od:02.02.2009
Lokacija:Osijek

Predmet:Re: Kopiranje baze (nova godina)

Evo to je to radi izvrsno. Jedino kako provjeriti dali baza koja se pravi več postoji da korisnik nebi pregazio staru bazu.

PreuzmiIzvorni kôd (vbnet):

Function NovaGodina(Godina)
Dim Db As Database, NovaDb As Database
Dim SQL As String
Dim Rs As Recordset
Dim PutanjaBaza As String, Putanja As String
Dim ImeNoveBaze As String
Dim Sl_PocetnaJM As Recordset
Dim Sl_ZavrsnaJM As Recordset
Dim Sl_PocetnaSKL As Recordset
Dim Sl_ZavrsnaSKL As Recordset
Dim Sl_PocetnaDOB As Recordset
Dim Sl_ZavrsnaDOB As Recordset
Dim Sl_PocetnaMAT As Recordset
Dim Sl_ZavrsnaMAT As Recordset
Dim Sl_PocetnaDUL As Recordset
Dim Sl_ZavrsnaDUL As Recordset
Dim Sl_PocetnaDIZ As Recordset
Dim Sl_ZavrsnaDIZ As Recordset
Dim Sl_PocetnaKTA As Recordset
Dim Sl_ZavrsnaKTA As Recordset
Dim Sl_PocetnaUL As Recordset
Dim Sl_ZavrsnaUL As Recordset
Set Db = CurrentDb()
SQL = "SELECT TOP 1 Database " _
& "FROM MSysObjects " _
& "WHERE Database Is Not Null"
Set Rs = Db.OpenRecordset(SQL)
Putanja = Rs.Fields(0)
Rs.Close
PutanjaBaza = Put_Baza(Putanja)
ImeNoveBaze = "Skladiste_" & Godina & "_be.mdb"
FileCopy PutanjaBaza & "be.sys", PutanjaBaza & ImeNoveBaze
Set NovaDb = OpenDatabase(PutanjaBaza & ImeNoveBaze)
'Kopiranje u tablicu Jedinice
Set Sl_PocetnaJM = Db.OpenRecordset("Jedinice", dbOpenDynaset)
Set Sl_ZavrsnaJM = NovaDb.OpenRecordset("Jedinice", dbOpenDynaset)
If Sl_PocetnaJM.RecordCount > 0 Then
Sl_PocetnaJM.MoveFirst
While Not Sl_PocetnaJM.EOF
With Sl_ZavrsnaJM
.AddNew
![JM] = Sl_PocetnaJM![JM]
![MJERA] = Sl_PocetnaJM![MJERA]
.Update
End With
Sl_PocetnaJM.MoveNext
Wend
End If
'Kopiranje u tablicu SkladiÅ¡ta
Set Sl_PocetnaSKL = Db.OpenRecordset("SkladiÅ¡ta", dbOpenDynaset)
Set Sl_ZavrsnaSKL = NovaDb.OpenRecordset("SkladiÅ¡ta", dbOpenDynaset)
If Sl_PocetnaSKL.RecordCount > 0 Then
Sl_PocetnaSKL.MoveFirst
While Not Sl_PocetnaSKL.EOF
With Sl_ZavrsnaSKL
.AddNew
![IDSkladiÅ¡ta] = Sl_PocetnaSKL![IDSkladiÅ¡ta]
![NazivSkladiÅ¡ta] = Sl_PocetnaSKL![NazivSkladiÅ¡ta]
.Update
End With
Sl_PocetnaSKL.MoveNext
Wend
End If
'Kopiranje u tablicu Dobavljaci
Set Sl_PocetnaDOB = Db.OpenRecordset("tblDobavljaci", dbOpenDynaset)
Set Sl_ZavrsnaDOB = NovaDb.OpenRecordset("tblDobavljaci", dbOpenDynaset)
If Sl_PocetnaDOB.RecordCount > 0 Then
Sl_PocetnaDOB.MoveFirst
While Not Sl_PocetnaDOB.EOF
With Sl_ZavrsnaDOB
.AddNew
![IDdobavljaca] = Sl_PocetnaDOB![IDdobavljaca]
![Dobavljac] = Sl_PocetnaDOB![Dobavljac]
![Mjesto] = Sl_PocetnaDOB![Mjesto]
![Adresa] = Sl_PocetnaDOB![Adresa]
![DrÅ¾ava] = Sl_PocetnaDOB![DrÅ¾ava]
.Update
End With
Sl_PocetnaDOB.MoveNext
Wend
End If
'Kopiranje u tablicu MAT
Set Sl_PocetnaMAT = Db.OpenRecordset("MAT", dbOpenDynaset)
Set Sl_ZavrsnaMAT = NovaDb.OpenRecordset("MAT", dbOpenDynaset)
If Sl_PocetnaMAT.RecordCount > 0 Then
Sl_PocetnaMAT.MoveFirst
While Not Sl_PocetnaMAT.EOF
With Sl_ZavrsnaMAT
.AddNew
![MAT] = Sl_PocetnaMAT![MAT]
![MAT_IME] = Sl_PocetnaMAT![MAT_IME]
![Kvalitet] = Sl_PocetnaMAT![Kvalitet]
![JM] = Sl_PocetnaMAT![JM]
![primjedba] = Sl_PocetnaMAT![primjedba]
.Update
End With
Sl_PocetnaMAT.MoveNext
Wend
End If
'Kopiranje u tablicu tblDokumentiUlaz
Set Sl_PocetnaDUL = Db.OpenRecordset("tblDokumentiUlaz", dbOpenDynaset)
Set Sl_ZavrsnaDUL = NovaDb.OpenRecordset("tblDokumentiUlaz", dbOpenDynaset)
If Sl_PocetnaDUL.RecordCount > 0 Then
Sl_PocetnaDUL.MoveFirst
While Not Sl_PocetnaDUL.EOF
With Sl_ZavrsnaDUL
.AddNew
![IDdokumenta] = Sl_PocetnaDUL![IDdokumenta]
![Dokument] = Sl_PocetnaDUL![Dokument]
.Update
End With
Sl_PocetnaDUL.MoveNext
Wend
End If
'Kopiranje u tablicu tblDokumentiIzlaz
Set Sl_PocetnaDIZ = Db.OpenRecordset("tblDokumentiIzlaz", dbOpenDynaset)
Set Sl_ZavrsnaDIZ = NovaDb.OpenRecordset("tblDokumentiIzlaz", dbOpenDynaset)
If Sl_PocetnaDIZ.RecordCount > 0 Then
Sl_PocetnaDIZ.MoveFirst
While Not Sl_PocetnaDIZ.EOF
With Sl_ZavrsnaDIZ
.AddNew
![IDdokumenta] = Sl_PocetnaDIZ![IDdokumenta]
![Dokument] = Sl_PocetnaDIZ![Dokument]
.Update
End With
Sl_PocetnaDIZ.MoveNext
Wend
End If
'Kopiranje u tablicu Konta
Set Sl_PocetnaKTA = Db.OpenRecordset("Konta", dbOpenDynaset)
Set Sl_ZavrsnaKTA = NovaDb.OpenRecordset("Konta", dbOpenDynaset)
If Sl_PocetnaKTA.RecordCount > 0 Then
Sl_PocetnaKTA.MoveFirst
While Not Sl_PocetnaKTA.EOF
With Sl_ZavrsnaKTA
.AddNew
![Kto] = Sl_PocetnaKTA![Kto]
![NazivKta] = Sl_PocetnaKTA![NazivKta]
.Update
End With
Sl_PocetnaKTA.MoveNext
Wend
End If
'Kopiranje u tablicu Ulaz
Set Sl_PocetnaUL = Db.OpenRecordset("Q_Inventura", dbOpenDynaset)
Set Sl_ZavrsnaUL = NovaDb.OpenRecordset("Ulaz", dbOpenDynaset)
If Sl_PocetnaUL.RecordCount > 0 Then
Sl_PocetnaUL.MoveFirst
While Not Sl_PocetnaUL.EOF
With Sl_ZavrsnaUL
.AddNew
![Å ifraUlaz] = Sl_PocetnaUL![Sifra]
![Datum] = Sl_PocetnaUL![Datum]
![Skl] = Sl_PocetnaUL![Skl]
![Ulaz] = Sl_PocetnaUL![Ulaz]
![IDdokumenta] = 4
![Predatnica] = ""
![Dobavljac] = 1
![Nalog] = ""
![Regal] = ""
.Update
End With
Sl_PocetnaUL.MoveNext
Wend
End If
Kraj:
Set Db = Nothing
Set NovaDb = Nothing
End Function
Function Put_Baza(Putanja As String)
Dim tmp As String
tmp = Putanja
Do While right(tmp, 1) <> "\"
tmp = left(tmp, Len(tmp) - 1)
Loop
Put_Baza = tmp
End Function

Pozdrav