• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excel yardımı ile yedekleme

E

evren_01

Katılım
6 Temmuz 2004
Mesajlar
157
Excel Vers. ve Dili
Microsoft® Office 2019 TR
Arkadaşlar Exceli kullanarak her gün otomatik yedekleme yapmak istiyorum bunu nasıl yapabilirim ( yedekleme yeri network ortamında )
 
Aşağıdaki gibi bir kodla networkteki yolunu kendiniz belirleyerek farklı kaydederek yedekleyebilirsiniz.

[vb:1:751381e833]Sub farklıkaydet()
ActiveWorkbook.SaveAs Filename:="\\Sevkiyat\c\Belgelerim\s----2002-1.xls"
End Sub[/vb:1:751381e833]
 
Levent bey benim sormak istediğim aslında belgerimi komple kopyalayıp networkta başka bir bilgisayara düzenli olarak yedek almaktır.
 
Belgelerim derken belgelerim klasörünün tamamınımı kasdediyorsunuz.
 
Merhaba;

Aşağıdaki kodları bir Excel dosyasında oluşturacağınız yeni bir modul içine kopyaladıktan sonra, Test isimli prosedurü çalıştırdığınızda bilgisayarda size ait My Documents - Belgelerim klasörünün tüm içeriği yerel ağda \\BilgisayarAdi\KlasorAdi\TempFolder\ adresine kopyalanacaktır.

Prosedürün çalışması için, kodlardaki BackUpPath sabitine, doğru dosya yolunu girmeniz gerekmektedir.

[vb:1:cc53d491ea]Type SHITEMID
cb As Long
abID As Byte
End Type

Type ITEMIDLIST
mkid As SHITEMID
End Type
'
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
'
Const CSIDL_PERSONAL As Long = &H5
Const BackUpPath As String = "\\BilgisayarAdi\KlasorAdi\TempFolder\"
Dim MyDocFolder As String
'
Sub Test()
MyDocFolder = GetSpecialfolder(CSIDL_PERSONAL)
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFolder MyDocFolder, BackUpPath
End Sub
'
Private Function GetSpecialfolder(CSIDL As Long) As String
Dim r As Long
Dim Path$
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = 0 Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetSpecialfolder = Left$(Path$, InStr(Path$, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function
[/vb:1:cc53d491ea]
 
Sn Raider bu makroyu belgerimden başka verileride yedeklemek sitersem nasıl olacak mesela masaüsütndeki evramlarım diye dosyayı da yedeklmek istersem
 
masaüsütndeki evramlarım diye dosyayı da yedeklmek istersem
Genişletmek için tıkla ...

Bu "evraklarım" dosya mı, klasor mü ? Yani evraklarım.xls gibi bir şey mi, yoksa klasör mü ?
 
Þimdi şöyle yapalım;

Yukarıdaki önerimin revize edilmiş şekliyle bu kez;

1)Kullanıcıya ait My Documents - Belgelerim klasörü ve içindekiler,

2) Masa üstündeki TestFolder adındaki bir klasör,

3) Yine masa üstündeki GetIcon.xls adındaki dosya,

kodlarda belirtildiği şekilde "\\BilgisayarAdi\KlasorAdi\TempFolder\" adresine yedeklenmektedir.

Bununla ilgili kodlar;

[vb:1:fa5414b679]Type SHITEMID
cb As Long
abID As Byte
End Type

Type ITEMIDLIST
mkid As SHITEMID
End Type
'
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
'
Const CSIDL_PERSONAL As Long = &H5
Const CSIDL_DESKTOP As Long = &H0
Const BackUpPath As String = "\\BilgisayarAdi\KlasorAdi\TempFolder\"
Const strFileName As String = "GetIcon.xls"
Const strFolder As String = "TestFolder"
Dim MyDocFolder As String
Dim MyFile As String
Dim SourceFolder As String
'
Sub Test2()
SourceFolder = GetSpecialfolder(CSIDL_DESKTOP) & Application.PathSeparator & strFolder
MyFile = GetSpecialfolder(CSIDL_DESKTOP) & Application.PathSeparator & strFileName
MyDocFolder = GetSpecialfolder(CSIDL_PERSONAL)
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile MyFile, BackUpPath
fs.CopyFolder MyDocFolder, BackUpPath
fs.CopyFolder SourceFolder, BackUpPath
End Sub
'
Private Function GetSpecialfolder(CSIDL As Long) As String
Dim r As Long
Dim Path$
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = 0 Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetSpecialfolder = Left$(Path$, InStr(Path$, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function
[/vb:1:fa5414b679]
 
SN Raider ellerinize sağlık cok güzel calışıyor :dua2: :dua2:
Bir kücük sorum daha olacaktı diyelim kopyalamak istediğimiz dosyanın yerini değiştirmek için
GetSpecialfolder(CSIDL_DESKTOP) buradaki desktop ifadesini mi değiştiriyoruz
örneğin c:\ xx dosyası

Baska bir soru daha
kopyalamak istediğimiz yerdeki klasörün sonuna tarih atsak şöylemi olacak
\\BilgisayarAdi\KlasorAdi\TempFolder\1 & Date & :oops:
 
Merhaba;

fs.CopyFile MyFile, BackUpPath
fs.CopyFolder MyDocFolder, BackUpPath
fs.CopyFolder SourceFolder, BackUpPath
Genişletmek için tıkla ...

Yukarıdaki satırlarda MyDocFolder, SourceFolder, BackUpPath değişkenlerine açık olarak dosya yollarını yazarsanız, olur. Kodları inceleyerek sonuca ulaşabilirsiniz.
 
Tekrar merhaba;

Baska bir soru daha
kopyalamak istediğimiz yerdeki klasörün sonuna tarih atsak şöylemi olacak
\\BilgisayarAdi\KlasorAdi\TempFolder\1 & Date &
Genişletmek için tıkla ...

Son mesajınızda yer alan ve yukarıdaki alıntıda belirttiğim kısım, gözümden kaçmış.

Sanırım, günlük yedeklerinizi ayrı ayrı klasörlerde saklamak istiyorsunuz. Bu durum için revize edilmiş kodları aşağıda veriyorum.

[vb:1:2b86c65408]Type SHITEMID
cb As Long
abID As Byte
End Type

Type ITEMIDLIST
mkid As SHITEMID
End Type
'
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, Nsize As Long) As Long
'
Const CSIDL_PERSONAL As Long = &H5
Const CSIDL_DESKTOP As Long = &H0
Const BackUpPath As String = "\\BilgisayarAdi\KlasorAdi\TempFolder\"
'Const BackUpPath As String = "C:\TempFolder\"
Const strFileName As String = "GetIcon.xls"
Const strFolder As String = "TestFolder"
Dim MyDocFolder As String
Dim MyFile As String
Dim SourceFolder As String
'
Sub Test3()
Dim BackUpFolder As String, MyMsg As String
Dim FSO As Object
Dim MyQ As VbMsgBoxResult
Dim LogFile As String
Dim FileNumber As Long
Dim LogCap1 As String * 35, LogCap2 As String * 33
Dim LogCap3 As String * 28, LogCap4 As String
Dim LogData1 As String * 20, LogData2 As String * 25
Dim LogData3 As String * 30
Dim Buffer As String * 100
Dim BuffLen As Long
Dim NTuser As String
Set FSO = CreateObject("Scripting.FileSystemObject")

BackUpFolder = BackUpPath & Date
LogFile = BackUpPath & "Log.txt"

If Dir(LogFile) = "" Then
LogCap1 = String(7, " ") & "İşlem"
LogCap2 = "Dosya"
LogCap3 = "Tarih"
LogCap4 = "Kullanıcı"
FileNumber = FreeFile
Open LogFile For Append As #FileNumber
Print #FileNumber, LogCap1; LogCap2; LogCap3; LogCap4
Print #FileNumber, String(100, "*")
Close #FileNumber
End If

If Not FSO.FolderExists(BackUpFolder) Then
MyMsg = BackUpFolder & vbCrLf & vbCrLf & _
"Belirtilen dosya yolu mevcut değil !" _
& vbCrLf & "Þimdi yaratmak istermisiniz ?"
MyQ = MsgBox(MyMsg, vbYesNo + vbInformation, "Kullanıcının dikkatine !")
If MyQ = vbYes Then
FSO.CreateFolder (BackUpFolder)
Else
MyMsg = "Yedekleme yapılmadan işlem sonlandırılacak !"
MsgBox MyMsg, vbInformation, "Kullanıcının dikkatine !"
Exit Sub
End If
Else
FSO.DeleteFolder (BackUpFolder), True
FSO.CreateFolder (BackUpFolder)
End If

SourceFolder = GetSpecialfolder(CSIDL_DESKTOP) _
& Application.PathSeparator & strFolder
MyFile = GetSpecialfolder(CSIDL_DESKTOP) & _
Application.PathSeparator & strFileName
MyDocFolder = GetSpecialfolder(CSIDL_PERSONAL)
BackUpFolder = BackUpFolder & Application.PathSeparator

FSO.CopyFile MyFile, BackUpFolder
FSO.CopyFolder MyDocFolder, BackUpFolder
FSO.CopyFolder SourceFolder, BackUpFolder

FileNumber = FreeFile
LogData1 = "Son yedekleme :"
LogData2 = "[ " & Date & " klasoru" & " ]"
LogData3 = Format(Now, "dd.mm.yyyy hh:mm:ss")
BuffLen = 100
GetUserName Buffer, BuffLen
NTuser = Left(Buffer, BuffLen - 1)
Open LogFile For Append As #FileNumber
Print #FileNumber, LogData1; LogData2; LogData3; NTuser
Close #FileNumber

MyMsg = BackUpFolder & vbCrLf & vbCrLf & "Yedekleme işlemi tamamlandı !"
MsgBox MyMsg, vbInformation, "Kullanıcının dikkatine !"

Set FSO = Nothing
End Sub
'
Function GetSpecialfolder(CSIDL As Long) As String
Dim r As Long
Dim Path$
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = 0 Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetSpecialfolder = Left$(Path$, InStr(Path$, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function

[/vb:1:2b86c65408]


Edit:
1) Ayrıca yukarıdaki kodlara, klasörlerin en son ne zaman yedeklendiğini de kaydeden bir *.txt dosyasını da, yine yedeklerin alındığı klasörün içine yerleştiren bir ilave yaptım.
2) *.txt dosyasında değişiklik yapıldı
 
Sn. evren_01;

Merakımdan soruyorum, güncellenmiş şekliyle yukarıdaki son önerim işinize yaradı mı acaba ?
 
teşekkür ederim
kusura bakmayın gec cevap veridiğim için
gercekten cook hoş
ellerinize sağlık
 
İşinize yaradığına sevindim.
 
Arkadaşlar bu konu hakkında yeni bir sorun ile karşılaştım

Networkta yedeklemek istediğim biligisayarda kullanıcı adı ve şifre soruyoor

Benim merak ettiğm kullanıcı adını ve şifresini giripte sonra yedeklemeye devam etmenin bir yolu var mı

Cevap larınızı bekliyorum..

:dua: :dua: :dua:
 
Sub farklıkaydet()
ActiveWorkbook.SaveAs Filename:="\\Sevkiyat\c\Belgelerim\s----2002-1.xls"
End Sub
Genişletmek için tıkla ...


bu yöntemi kullanıyorum ancak her seferinde "bu zaten dosya var ...." uyarısı geliyor. Bu uyarıyı almadan otomatik olarak kaydettirebilir miyiz?
 
merhaba arkadaşlar,
yedeklememi yukarıdaki kodlarla yapmak istiyorum, bu kodlara birde winrar programı ile sıkıştırma fonksiyonu eklenebilir mi acaba?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst