• DİKKAT

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

Yedek Alma Problemi

K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,676
Excel Vers. ve Dili
Excel 2010 32 bit
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
Kod: 
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
Kod: 
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
 
kemal turan' Alıntı:
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
Kod: 
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
Kod: 
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
Genişletmek için tıkla ...
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"
 
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.
 
kemal turan' Alıntı:
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.
Genişletmek için tıkla ...
Laptop ve PC'de Office sürümü aynımı_?

Bana hala laptopda o klasörlerdein yolunda bir hata var gibi geliyor.
 
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
 
kemal turan' Alıntı:
manuel kopyala yapıştırda sıkıntı yok
Genişletmek için tıkla ...
Yolu bu şekilde yapıp denermisiniz_?
Yani tarihsel bişey olmasın.

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

Bu da olmazsa, üstteki koda Masaüstü yolunu girerek birde deneyin, onda da hata veriyormu_?
 
Bu satırda yine hata veriyor
ds.CopyFile ThisWorkbook.FullName, yol
 
BaY_KaPTaN' Alıntı:
Örnek dosya atarmısınız, aynı isimde olursa iyi olur.
Genişletmek için tıkla ...
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
 
kemal turan' Alıntı:
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
Genişletmek için tıkla ...

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.
 
Verdiği hatanın görselini de paylaşabilirseniz yönlendirici olabilir.
 

Ekli dosyalar

  • WhatsApp Image 2024-02-02 at 17.23.50.jpeg
    WhatsApp Image 2024-02-02 at 17.23.50.jpeg
    345.1 KB · Görüntüleme: 10
  • WhatsApp Image 2024-02-02 at 17.23.49 (1).jpeg
    WhatsApp Image 2024-02-02 at 17.23.49 (1).jpeg
    292.3 KB · Görüntüleme: 10
  • WhatsApp Image 2024-02-02 at 17.23.49.jpeg
    WhatsApp Image 2024-02-02 at 17.23.49.jpeg
    233.4 KB · Görüntüleme: 7
Korhan Hocam
Aşağıda makro kullanarak farklı kaydet seçeneği ile yedek dosyayı kayıt ediyor
Kod: 
    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
 
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.
 
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.

Kod: 
copy %1 %2
pause

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

Kod: 
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
 
Son düzenleme:
Asri bey merhaba
Çok teşekkür ederim.
Selametle kalınız
 
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.
 
kemal turan' Alıntı:
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.
Genişletmek için tıkla ...
yedekal.bat dosyasına pause ekleyip hata olarak ne yazdığına bakabilir misiniz.

copy %1 %2
pause
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst