Otomatik Yedekleme Yapmak
Tarih
04/11/2010 15:15
Konu Sahibi
gitarc
Yorumlar
2
Okunma
2245
Konuyu Oyla:
  • Derecelendirme: 5/5 - 1 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 5/5 - 1 oy



gitarc
Aktif Üye
Kullanici Avatari
Aktif Üye
14
01/11/2010
0
Balıkesir
Ofis XP
02/07/2011,15:21
Merhaba Arkadaşlar bu kodlar ile otomatik yedekelem yapmaya çalışacağız veri tabanı dosyasını.
Bir adet mdi form ( FrmMain) ve bu forma ayaralar adında bir menü yapıyoruz ve aşağıdaki kodları mdi forma yapıştırıyoruz. ve Projemize references de dao360.dll eklemeyi unutmuyoruz. ve veritabanımızın adı vt1.mdb veritabanı klasörünün adıda veritabanı olmalı
sonra aşağıdaki kodlar gerekli formlara eklemeliyiz

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
Option Explicit
'değişkenleri tanımlıyoruz
Dim otoyedeklead1, yedekle, otoyedekle



Private Sub MDIForm_Resize()

otoyedeklead1 = GetSetting("huseyin", "Settings", "otoyedeklead")
If otoyedeklead1 = "" Then
SaveSetting "huseyin", "Settings", "otoyedeklead", "c:/veritabani/" & Date & ".ydk"
End If
yedekle = GetSetting("huseyin", "Settings", "yedekle")
If yedekle = "" Then
SaveSetting "huseyin", "Settings", "yedekle", "c:/veritabani/vt1.ydk"
End If

otoyedekle = GetSetting("huseyin", "Settings", "otoyedekle")
If otoyedekle = "" Then
SaveSetting "huseyin", "Settings", "otoyedekle", Date
SaveSetting "huseyin", "Settings", "otoyedeklegun", 10


End If
' eğer kayıt defterinde ototyedekle alanı yoksa giriş yapıyoruz

otoyedekle = GetSetting("huseyin", "Settings", "otoyedekle")
If otoyedekle = "" Then
SaveSetting "huseyin", "Settings", "otoyedekle", Date
SaveSetting "huseyin", "Settings", "otoyedeklegun", 10
End If

otoyedekle = GetSetting("huseyin", "Settings", "otoyedekle")
If CDate(otoyedekle) <= Date Then
otoyedekleme.Show
Else
'MsgBox "Değil"
End If

End Sub

Private Sub mnuayar_Click()
ayarlar.Show
End Sub


şimide bir form daha ekliyoruz ve adını ayarlar yapıp aşagıdaki kodlar yapıştırıyoruz. bu forma bir adet commandbuton ve bir adet textbox (Text1) yerleştirip kodları yazınız

Private Sub Command1_Click()
If Text1 < 0 Or Text1 > 31 Then
MsgBox " buraya 0`dan büyük 31`den küçük bir sayı girmelisiniz", vbCritical, "Hüseyin"
Text1.SetFocus
Exit Sub
Else
End If
SaveSetting "huseyin", "Settings", "otoyedekle", DateAdd("d", Text1Text, Date)
SaveSetting "huseyin", "Settings", "otoyedeklegun", Text1.Text
Unload Me
End Sub

Private Sub Form_Load()
Text1.Text = GetSetting("huseyin", "Settings", "otoyedeklegun")

End Sub

en son olarak bir form daha ekleiyoruz ve adınınıda otoyedekle yapıp kodları yazıyoruz ve bu forma bir adet Timer (Timer1) 2 adet textbox (Text1, Text2 ) ve bir adet Progresbar ( ProgresBar1) yerleştiriyoruz


Option Explicit
' Fonksiyon ve özellikleri tanımlıyoruz
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Const HWND_TOPMOST = -1 ' Hep üstte tutan değişken değer
Const HWND_NOTOPMOST = -2 ' Hep üstte özelliğini yok eden değişken değer...
Const SWP_NOSIZE = &H1 ' Formun boyutlarını değiştirilmez yapar...
Const SWP_NOMOVE = &H2 ' Formu taşınmaz yapar...
Const SWP_NOACTIVATE = &H10 ' Form Aktif yapılmaz...
Const SWP_SHOWWINDOW = &H40 ' Pencere Görünür Yapılır...
Private Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

Private Sub Form_Activate()
On Error Resume Next
' Eğer veritabanı dizini ve dosyası bulunmazsa formu kapatıyoruz

If Dir$("c:/veritabani/vt1.mdb") = "" Then
Unload Me
Exit Sub
Else
End If
' Formu en üste tutmak içIn
SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE _
Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
' formu seçilemez yapıyoruzki işlem kulanıcı tarafından iptal edilemsin
otoyedekleme.Enabled = False
Dim dbsvt1 As Database
Dim dbsvt As Database

' veritabanı yolu
Set dbsvt1 = OpenDatabase("c:/veritabani/vt1.mdb")
' yedeklenecek veritabanı dosyasını sıkıştırarak boyutunu kültüyoruz
With dbsvt1
Debug.Print .Name & ", version " & .Version
Debug.Print " CollatingOrder = " & .CollatingOrder
.Close
End With

If Dir("c:/veritabani/vt.mdb") <> "" Then _
Kill "c:/veritabani/vt.mdb"

DBEngine.CompactDatabase "c:/veritabani/vt1.mdb", _
"c:/veritabani/vt.mdb", dbLangTurkish

Set dbsvt = OpenDatabase("c:/veritabani/vt.mdb")

With dbsvt
Debug.Print .Name & ", version " & .Version
Debug.Print " CollatingOrder = " & .CollatingOrder
.Close
End With
Kill "c:/veritabani/vt1.mdb"
Name "c:/veritabani/vt.mdb" As "c:/veritabani/vt1.mdb"

Dim i
Timer1.Enabled = False
ProgressBar1.Value = 0
' ana formu kulanıma kapatıyoruz
frmMain.Enabled = False
Kill Text1.Text
RmDir Mid(Text1.Text, 1, 1) & ":/huseyin/"
MkDir Mid(Text1.Text, 1, 1) & ":/huseyin"

Dim n As Long
n = CopyFile("c:/veritabani/vt1.mdb", Text1.Text, False)
If (n = 1) Then
'MsgBox "Dosya Başarılı Olarak : Aşağıdaki Sürücüye " & Chr(10) & " " & Text1 & Chr(10) & "Olarak Yedeklendi", 48, "Deneme Firması"

' sonraki yedekleme içIn tarih belirtiyoruz
SaveSetting "huseyin", "Settings", "otoyedekle", DateAdd("d", Text2.Text, Date)

For i = 0 To 100 Step 0.01

ProgressBar1.Value = i
DoEvents
Next i

Timer1.Enabled = True

Exit Sub
Else
otoyedekleme.Visible = False
MsgBox " Dosya Yedekleme Hatası!! Yedekleme Aracını Kulanarak Bir Dizin Belirtin", vbCritical, "Deneme Firması"
frmMain.Enabled = True
Unload Me
End If

Timer1.Enabled = True

End Sub

Private Sub Form_Load()
On Error Resume Next
Text1.Text = GetSetting("huseyin", "Settings", "otoyedeklead")
SaveSetting "huseyin", "Settings", "otoyedeklead", Mid(Text1, 1, 2) & "/huseyin/" & Date & ".ydk"

Text1.Text = GetSetting("huseyin", "Settings", "otoyedeklead")
Text2.Text = GetSetting("huseyin", "Settings", "otoyedeklegun")

End Sub

Private Sub Timer1_Timer()
' ana formu kulanıma açıyoruz
frmMain.Enabled = True
Unload Me

End Sub

PROGRAMMER MEHMET
Cevapla


rfve
Üye
Kullanici Avatari
Üye
16
2
30/09/2010
0
Edirne
Ofis XP
29/09/2015,10:21
ben biraz acemiyim de.
acaba örnek ekleme şansın varmı.?
Cevapla


benremix
Uzman
Kullanici Avatari
Uzman
R.... S....
4.432
17/05/2009
365
Ankara
Ofis 2010
Dün,09:18
Emek ve paylaşım için teşekkürler. Bence de örnekle desteklemek lazım.
Saygılar...
Bilgi paylaşıldıkça çoğalır....
Her engel, yaşam koşullarınızı daha iyileştirecek bir fırsattır.


Access için her zaman lazım olacak konu başlıkları listesi 


Cevapla







Konuyu Okuyanlar: 1 Ziyaretçi



Türkçe Çeviri: MCTR, Forum Yazılımı: MyBB, © 2002-2016 MyBB Group.
DMCA.com Protection Status
© Desing by XSTYLED| Develops by ozanakkaya