-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Excel yardımı ile yedekleme
- Konbuyu başlatan evren_01
- Başlangıç tarihi
- Katılım
- 13 Ekim 2004
- Mesajlar
- 16,057
- Excel Vers. ve Dili
-
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
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]
[vb:1:751381e833]Sub farklıkaydet()
ActiveWorkbook.SaveAs Filename:="\\Sevkiyat\c\Belgelerim\s----2002-1.xls"
End Sub[/vb:1:751381e833]
- Katılım
- 13 Ekim 2004
- Mesajlar
- 16,057
- Excel Vers. ve Dili
-
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Belgelerim derken belgelerim klasörünün tamamınımı kasdediyorsunuz.
Haluk
Özel Üye
- Katılım
- 7 Temmuz 2004
- Mesajlar
- 12,406
- Excel Vers. ve Dili
-
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
- Altın Üyelik Bitiş Tarihi
- ∞
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]
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]
Haluk
Özel Üye
- Katılım
- 7 Temmuz 2004
- Mesajlar
- 12,406
- Excel Vers. ve Dili
-
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
- Altın Üyelik Bitiş Tarihi
- ∞
Ã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]
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 &
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 &
Haluk
Özel Üye
- Katılım
- 7 Temmuz 2004
- Mesajlar
- 12,406
- Excel Vers. ve Dili
-
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
- Altın Üyelik Bitiş Tarihi
- ∞
Merhaba;
Yukarıdaki satırlarda MyDocFolder, SourceFolder, BackUpPath değişkenlerine açık olarak dosya yollarını yazarsanız, olur. Kodları inceleyerek sonuca ulaşabilirsiniz.
Haluk
Özel Üye
- Katılım
- 7 Temmuz 2004
- Mesajlar
- 12,406
- Excel Vers. ve Dili
-
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
- Altın Üyelik Bitiş Tarihi
- ∞
Tekrar merhaba;
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ı
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ı
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:
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: