Yedek Alma Problemi

[kemal turan]

merhaba
aşağdaki kodlar normal bilgisayarda çalışıyor. Fakat bir laptop ta aşagıdaki bold olansatırlarda hata veriyor.
Nasıl çözebiliriz.
Teşekkür ederim
CreateObject("Scripting.FileSystemObject").CopyFile ThisWorkbook.FullName, Kayıt_Yeri
ds.CopyFile ThisWorkbook.FullName, yol

Private Sub CommandButton21_Click()
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
Dim Klasor As String, uzanti As String, dosya As String
Klasor = "c:\Yedekler"
uzanti = Right(ThisWorkbook.name, InStr(1, StrReverse(ThisWorkbook.name), ".", vbTextCompare) - 1)
dosya = Mid(ThisWorkbook.name, 1, Len(ThisWorkbook.name) - Len(uzanti) - 1)
ActiveWorkbook.Save
Application.DisplayAlerts = False
Yedek_Dosya_Adı = "DOĞA MOB. CARİ TAKİP PROĞRAMI " & dosya & Format(Now, " dd_mm_yyyy_hh_nn_ss") & "." & uzanti
Kayıt_Yeri = Klasor & "\" & Yedek_Dosya_Adı
If CreateObject("Scripting.FileSystemObject").FolderExists(Klasor) = False Then
MkDir Klasor
End If
CreateObject("Scripting.FileSystemObject").CopyFile ThisWorkbook.FullName, Kayıt_Yeri
MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Chr(10) & Kayıt_Yeri, vbInformation, "U Y A R I "
Application.DisplayAlerts = True
ThisWorkbook.Close
Application.Quit
End Sub

Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save

ds.CopyFile ThisWorkbook.FullName, yol
If ds.FolderExists("E:\MUHASEBE PROĞRAMI") = False Then
ds.CreateFolder "E:\MUHASEBE PROĞRAMI"
End If
If ThisWorkbook.Path = "E:\MUHASEBE PROĞRAMI" Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "VBA KT YAZILIM") = vbYes Then
yol = "E:\MUHASEBE PROĞRAMI\" & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
ds.CopyFile ThisWorkbook.FullName, yol
End If
ThisWorkbook.Close
Application.Quit

 

[BaY_KaPTaN]

merhaba
aşağdaki kodlar normal bilgisayarda çalışıyor. Fakat bir laptop ta aşagıdaki bold olansatırlarda hata veriyor.
Nasıl çözebiliriz.
Teşekkür ederim
CreateObject("Scripting.FileSystemObject").CopyFile ThisWorkbook.FullName, Kayıt_Yeri
ds.CopyFile ThisWorkbook.FullName, yol

Private Sub CommandButton21_Click()
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
Dim Klasor As String, uzanti As String, dosya As String
Klasor = "c:\Yedekler"
uzanti = Right(ThisWorkbook.name, InStr(1, StrReverse(ThisWorkbook.name), ".", vbTextCompare) - 1)
dosya = Mid(ThisWorkbook.name, 1, Len(ThisWorkbook.name) - Len(uzanti) - 1)
ActiveWorkbook.Save
Application.DisplayAlerts = False
Yedek_Dosya_Adı = "DOĞA MOB. CARİ TAKİP PROĞRAMI " & dosya & Format(Now, " dd_mm_yyyy_hh_nn_ss") & "." & uzanti
Kayıt_Yeri = Klasor & "\" & Yedek_Dosya_Adı
If CreateObject("Scripting.FileSystemObject").FolderExists(Klasor) = False Then
MkDir Klasor
End If
CreateObject("Scripting.FileSystemObject").CopyFile ThisWorkbook.FullName, Kayıt_Yeri
MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Chr(10) & Kayıt_Yeri, vbInformation, "U Y A R I "
Application.DisplayAlerts = True
ThisWorkbook.Close
Application.Quit
End Sub

Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save

ds.CopyFile ThisWorkbook.FullName, yol
If ds.FolderExists("E:\MUHASEBE PROĞRAMI") = False Then
ds.CreateFolder "E:\MUHASEBE PROĞRAMI"
End If
If ThisWorkbook.Path = "E:\MUHASEBE PROĞRAMI" Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "VBA KT YAZILIM") = vbYes Then
yol = "E:\MUHASEBE PROĞRAMI\" & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
ds.CopyFile ThisWorkbook.FullName, yol
End If
ThisWorkbook.Close
Application.Quit

Merhaba.
Diğer bilgisayarda da klasör yolu aynı değilse hata verir.
Aşağıdaki klasör yolunu kontrol edin laptop'ta.
Klasor = "c:\Yedekler"
ds.CreateFolder "E:\MUHASEBE PROĞRAMI"

 

[kemal turan]

Klasör yolu doğru benim laptop ve PC de sıkıntı yok
Sıkıntı olan laptop ta C de dosya adı doğru buna rağmen hata veriyor
2 nci kodu yıllardır kullanıyorum.

 

[BaY_KaPTaN]

Klasör yolu doğru benim laptop ve PC de sıkıntı yok
Sıkıntı olan laptop ta C de dosya adı doğru buna rağmen hata veriyor
2 nci kodu yıllardır kullanıyorum.

Laptop ve PC'de Office sürümü aynımı_?

Bana hala laptopda o klasörlerdein yolunda bir hata var gibi geliyor.

 

[kemal turan]

2 nci kodda E yazıyor ben C olarak değiştiriyorum sanki laptop izin vermiyor.
Yine 2 nci kodda eğer klasör yok ise klasörü açıyor fakat kayıt yapmıyor
Bilginize

 

[BaY_KaPTaN]

2 nci kodda E yazıyor ben C olarak değiştiriyorum sanki laptop izin vermiyor.
Yine 2 nci kodda eğer klasör yok ise klasörü açıyor fakat kayıt yapmıyor
Bilginize

O klasöre siz kendiniz elle dosya kaydedebiliyormusunuz_?

 

[kemal turan]

manuel kopyala yapıştırda sıkıntı yok

 

[BaY_KaPTaN]

manuel kopyala yapıştırda sıkıntı yok

Yolu bu şekilde yapıp denermisiniz_?
Yani tarihsel bişey olmasın.

yol = "E:\MUHASEBE PROĞRAMI\"  & ThisWorkbook.Name & "- YEDEK"

Bu da olmazsa, üstteki koda Masaüstü yolunu girerek birde deneyin, onda da hata veriyormu_?

 

[kemal turan]

Bu satırda yine hata veriyor
ds.CopyFile ThisWorkbook.FullName, yol

 

[BaY_KaPTaN]

Bu satırda yine hata veriyor
ds.CopyFile ThisWorkbook.FullName, yol

Örnek dosya atarmısınız, aynı isimde olursa iyi olur.

 

[kemal turan]

Örnek dosya atarmısınız, aynı isimde olursa iyi olur.

Kürşat bey
Dosyada veya içeriğinde hiç bir sıkıntı yok
Kod benim laptopda çalışıyor
Diğer PC lerde çalışıyor
Diğer laptop da ayarlarında veya Windows sürümünde birbir sıkıntı var herhalde

 

[BaY_KaPTaN]

Kürşat bey
Dosyada veya içeriğinde hiç bir sıkıntı yok
Kod benim laptopda çalışıyor
Diğer PC lerde çalışıyor
Diğer laptop da ayarlarında veya Windows sürümünde birbir sıkıntı var herhalde

Yardımcı olabilmek için, gözden kaçan birşey olabilir diye istemiştim fakat uzaktan bu kadar olabiliyor.

Aklıma gelen seçenekler;
1- Windows Sürümü Farklılığı - Laptop ve PC'den kontrol edin.
2- Office Sürüm Farklılığı - Laptop ve PC'den kontrol edin.
3- Klasör Yolu ile ilgili sıkıntı (Sıkıntı yok demiştiniz)
4- Dosya adıyla ilgili saatsel bir sıkıntı (Sıkıntı yok demiştiniz)
Diğer bilgileri bilemiyorum.

 

[Korhan Ayhan]

Verdiği hatanın görselini de paylaşabilirseniz yönlendirici olabilir.

 

[kemal turan]

Verdiği hatanın görselini de paylaşabilirseniz yönlendirici olabilir.

Korhan hocam merhaba
Resimler ek'tedir

 

[kemal turan]

Korhan Hocam
Aşağıda makro kullanarak farklı kaydet seçeneği ile yedek dosyayı kayıt ediyor

    ChDir "C:\MUHASEBE PROĞRAM"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\MUHASEBE PROĞRAM\DOĞA BELLONA SATIŞ TAHSİLAT PROĞRAMI V3 222.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

 

[kemal turan]

Korhan Hocam merhaba
Aşapıdaki youtube linkinde "Bad file name or number" hatasının antivirüs proğramından kaynaklandığını açıklıyor.
Ondan olsa gerek. Karşı bilgisayardaki virüs proğramı farklı olduğundan çözümü birebir uygulayamadım.

 

[Asri]

C:\yedekler klasörü içine yedekal.bat dosyasını oluşturun.
dosya içindeki pause komutu işlem sonucu gösterdikten sonra beklemesini sağlar.
İhtiyaç yok ise eklenmeyebilir.

copy %1 %2
pause

yedekleme kodu aşağıdaki şekilde kullanın.

Private Sub CommandButton21_Click()
    Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
    Dim Klasor As String, uzanti As String, dosya As String

    Klasor = "c:\Yedekler"
    uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare) - 1)
    dosya = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - Len(uzanti) - 1)
    ActiveWorkbook.Save

    Application.DisplayAlerts = False
    Yedek_Dosya_Adı = "DOĞA MOB. CARİ TAKİP PROĞRAMI " & dosya & Format(Now, " dd_mm_yyyy_hh_nn_ss") & "." & uzanti
    Kayıt_Yeri = Klasor & "\" & Yedek_Dosya_Adı

    On Error Resume Next
    MkDir Klasor
    On Error GoTo 0

    CommandString = "c:\yedekler\yedekal.bat" + " " + """" + ThisWorkbook.FullName + """" + " " + """" + Kayıt_Yeri + """"
    Call Shell("cmd.exe /c" & CommandString, vbNormalFocus)

    MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Chr(10) & Kayıt_Yeri, vbInformation, "U Y A R I "

    Application.DisplayAlerts = True
    ThisWorkbook.Close
    Application.Quit
End Sub

 

[kemal turan]

Asri bey merhaba
Çok teşekkür ederim.
Selametle kalınız

 

[kemal turan]

Asri bey benim bilgisayarda çalışmıştı .
Karşı bilgisayar da yedekal.bat dosyası oluşturdum.
Hata vermedi yedek alınmıştır mesaj kutusu oluştu ama hedef yedekler klasöründe dosyayı kayıt etmedi.

 

[Asri]

Asri bey benim bilgisayarda çalışmıştı .
Karşı bilgisayar da yedekal.bat dosyası oluşturdum.
Hata vermedi yedek alınmıştır mesaj kutusu oluştu ama hedef yedekler klasöründe dosyayı kayıt etmedi.

yedekal.bat dosyasına pause ekleyip hata olarak ne yazdığına bakabilir misiniz.

copy %1 %2
pause