Dosyayı kapatırken yedeğini D sürücüsüne atma

[tufan03]

Kullanmakta olduğum dosyayı kapatırken dosyanın bir yedeğini D sürücüsüne atan makroyu nasıl oluşturabiliriz.
Selamlar

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodları Sn. ripek'in bir mesajından alıp kullanmıştım. Bu kodlar D sürücüsünü kontrol eder YEDEK isimli klasör varsa dosyayı isimle tarihi birleştirerek (Örneğin; STOK TAKİP 12 08 2006 şeklinde) yedekler. Eğer YEDEK isimli klasör yoksa oluşturup öyle dosyanızı yedekler.

Sub Yedek_Al()
    On Error Resume Next
    Dim FSO As Object
    Dim MyFolder, MyFile, MyFileEnd As String
    Dim S As Long
    MyFolder = "D:\YEDEK"
    MyFile = "YEDEK DOSYA ADINIZ"
    MyFileEnd = MyFile & " " & Format(Now, "dd mm yyyy") & ".xls"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not FSO.FolderExists(MyFolder) Then
    FSO.CreateFolder (MyFolder)
    End If
    
    ActiveWorkbook.SaveCopyAs Filename:=MyFolder & Application.PathSeparator & MyFileEnd
    
    Set FSO = Nothing
    
    S = Excel.Application.Windows.Count
    If S = 1 Then
    Application.Quit
    Else
    ActiveWorkbook.Close
    End If
End Sub

 

[tufan03]

Teşekkür ederim,Sayın COST CONTROL

 

[a_self_lion]

Sayın Cost Control burdaki kodlarda eğer Gazete_takip 22 10 2007 olarak kaydediyor çok güzel çalıştı. benim istediğim aynı gün eğer Gazete_takip 22 10 2007 dosyası varsa Gazete_takip 22 10 2007_2 şeklinde kayıtyapabilir mi? Teşekkürler.

 

[baydeniro]

Paylaşım İçin Teşekkürler

Sayın Cost Control ve sayın ripek. Paylaşım için teşekkürler.

 

[a_self_lion]

Sayın CostControl ve ripek bu sonuna tarih ve saatti de ekletebilirmiyiz.

 

[a_self_lion]

Tamamdır olayı çözdüm

On Error Resume Next
Dim FSO As Object
Dim MyFolder, MyFile, MyFileEnd As String
Dim S As Long
MyFolder = "D:\YEDEK"
MyFile = "GAZETE_TAKIP"
MyFileEnd = MyFile & " " & Format(Now, "dd mm yyyy-hh mm ss") & ".xls"


Set FSO = CreateObject("Scripting.FileSystemObject")

If Not FSO.FolderExists(MyFolder) Then
FSO.CreateFolder (MyFolder)
End If

ActiveWorkbook.SaveCopyAs Filename:=MyFolder & Application.PathSeparator & MyFileEnd

Set FSO = Nothing

S = Excel.Application.Windows.Count
If S = 1 Then
'Application.Quit
Else
'ActiveWorkbook.Close
End If

kodları bu şekilde düzenleyince düzeldi. Tam istediğim gibi oldu.

 

[mt621]

Sayın Cost Control
Çok güzel olmuş mümkünse bende iki ilave yapmanızı isteyecem
Birincisi tari ve saatin başına a1 deki veri gelmesi .İkincisi ise her seferinde a1 hücresnden sonra 1 artması
örnek : dosya1 tarih saat
dosya2 tarih saat
dosya3 tarih saat
yani her yedek aldığımda dosyaya a1 verisi yanında dosya numarası tarih saat gelmesi mümkünmü..

 

[hsayar]

satırını aşağıdaki gibi değiştiriniz;
a1 i ekleme için

MyFileEnd = MyFile & "-" & Range("a1").value & Format(Now, "dd mm yyyy") & ".xls"
Range("A1").value = Range("A1").value + 1

A1 in rakam olduğunu varsaydım.

 

[mt621]

sayın hsayar
a1 deki veriyi alıyor ama saydırma işlemi çalışmadı (value + 1)

 

[hsayar]

Sub Yedek_Al()
    On Error Resume Next
    Dim FSO As Object
    Dim MyFolder, MyFile, MyFileEnd As String
    Dim S As Long
    MyFolder = "e:\YEDEK"
    MyFile = ThisWorkbook.Name
    'MyFileEnd = MyFile & " " & Format(Now, "dd mm yyyy") & ".xls"
    MyFileEnd = MyFile & "-" & Range("a1").Value & "-" & Format(Now, "dd mm yyyy") & ".xls"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not FSO.FolderExists(MyFolder) Then
    FSO.CreateFolder (MyFolder)
    End If
    
    ActiveWorkbook.SaveCopyAs Filename:=MyFolder & Application.PathSeparator & MyFileEnd
    
    Set FSO = Nothing
    
    Sheets("sayfa1").Range("A1").Value = Range("A1").Value + 1
    ActiveWorkbook.Save
    S = Excel.Application.Windows.Count
    If S = 1 Then
    Application.Quit
    Else
    ActiveWorkbook.Close True
    End If
End Sub

böyle denermisiniz

 

[hsayar]

yanlış mesaj

 

[mt621]

sayın hsayar
sayfa kapanıyor ve sayı artmıyor

 

[hsayar]

makronun olduğu kitabı tekrar açın mutlaka artar arkadaşım denedim

gözleenizi için sayfayı kapatma kodlarının pasifize ettim deneyiniz

 

[mt621]

sayın hsayar
çok teşekkürler tam istediğim gibi oldu

 

[hsayar]

rica ederim