tarihli klasör yedekleme

[sratacc]

forumdaşlar selamlar.
yarım saattir arıyorum çok örnek buldum ama aradığımın tam karşılığını bulamadım.

kodu çalıştırdığımda

D:\CTD\ARŞİV(kaynak dosya) dosyasını
D:\CTD\YEDEK_ARŞİV(hedef dosya) dosyası altına bugün tarihli bir dosya oluşturup onun içine kopyalamasını istiyorum.

teşekkürler.

 

[tahsinanarat]

Sn. sratacc; Söz konusu
D:\CTD\ARŞİV(kaynak dosya) dosya açılırkenmi, kapanırkenmi yoksa açıkkenmi kod çalıştırılıp yedek aldırılacak?

 

[tahsinanarat]

Sn. sratacc, kaynak klasördeki kopyalamak istediğiniz kipat isimlerini a sutununa yazıp
aşağıdaki kodu çalıştırarak deneyiniz.
Sub dasyakopyala()
Dim DosyaSistemi
Dim StDatei As String
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "D:\CTD\ARŞİV\"
hedefKlasor = "D:\CTD\YEDEK_ARŞİV\"
On Error Resume Next
For i = 2 To [a65536].End(3).Row
Dosya = veriKlasor & Cells(i, 1).Value & ".xls"
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
DosyaSistemi.CopyFile Dosya, hedefKlasor & Cells(i, 1).Value & Format(Now, "DD-MM-YY") & "_" & Format(Now, "hh-mm") & "_" & StDatei & ".xls"
End If
Next i
End Sub

 

[sratacc]

Sn. sratacc, kaynak klasördeki kopyalamak istediğiniz kipat isimlerini a sutununa yazıp
aşağıdaki kodu çalıştırarak deneyiniz.
Sub dasyakopyala()
Dim DosyaSistemi
Dim StDatei As String
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "D:\CTD\ARŞİV\"
hedefKlasor = "D:\CTD\YEDEK_ARŞİV\"
On Error Resume Next
For i = 2 To [a65536].End(3).Row
Dosya = veriKlasor & Cells(i, 1).Value & ".xls"
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
DosyaSistemi.CopyFile Dosya, hedefKlasor & Cells(i, 1).Value & Format(Now, "DD-MM-YY") & "_" & Format(Now, "hh-mm") & "_" & StDatei & ".xls"
End If
Next i
End Sub

Sn. tahsinanarat listeden ziyade doğrudan kopyala yapıştır yapmasını istiyorum.
kodu bir butona atayıp butona tıkladığımda kaynak klasörün kopyalanarak hedef klasörü içerisinde bügun tarihli bir klasör oluşturulması ve onun içine kopyalanmasını istiyorum.

teşekkürler.

 

[halit3]

Alternatif kod

Sub klasorkopyala()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "D:\CTD\ARŞİV\"
hedefKlasor = "D:\CTD\YEDEK_ARŞİV\"
DosyaSistemi.CopyFolder veriKlasor, hedefKlasor & Format(Now, "dd-mm-yyyy  hh-nn-ss")
End Sub

 

[sratacc]

Alternatif kod

Sub klasorkopyala()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "D:\CTD\ARŞİV\"
hedefKlasor = "D:\CTD\YEDEK_ARŞİV\"
DosyaSistemi.CopyFolder veriKlasor, hedefKlasor & Format(Now, "dd-mm-yyyy  hh-nn-ss")
End Sub

teşekkürler sayın halit3