Kaydet makrosunda dosya yolu yoksa başka yola kaydetsin.

[S.Yiğit]

Merhabalar,

İşyerimde aşağıdaki kod ile dosyada çalışırken her kaydet yaptığımda dosyayı olduğu gibi belirttiğim yola kaydediyor. Sıkıntım ise evden bu klasörlere ulaştığımda yolu farklı olması.. iş yerinde Z: olan yol evden bağlandığımda Y: oluyor.

Thisworkbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
Dim d() As String, dosya As String, dosyaAdı As String, uzantı As String
 
With ActiveWorkbook
    d = Split(.Name, ".")
    uzantı = d(UBound(d))
    dosyaAdı = Left(.Name, Len(.Name) - Len(uzantı) - 1)
 
    dosya = "[COLOR="Red"][B]Z[/B][/COLOR]:\SAHA HIZMETLERI\FAYDALI BILGILER\yedekler\Montaj Takibi\Montaj Takibi ve Planlama Çizelgesi" & _
        Format(Now, " dd.mm.yyyy_hh/mm/ss") & "." & uzantı
 
    .SaveCopyAs Filename:=dosya
End With
 
End Sub

Kısacası

Z:\SAHA HIZMETLERI\FAYDALI BILGILER\yedekler\Montaj Takibi\Montaj Takibi ve Planlama Çizelgesi"

yolunu bulamadığında

Y:\SAHA HIZMETLERI\FAYDALI BILGILER\yedekler\Montaj Takibi\Montaj Takibi ve Planlama Çizelgesi" yoluna kaydetmeli

Dosyamın orjinal hali ektedir. başka makrolarda bulunmaktadır.

 

[Zeki Gürsoy]

Merhaba,

Ev ya da işyerinizde bu ağ sürücüsünden yalnız 1 tane ise etiketin ne olduğu (Y veya Z) önemli değildir.

Bunu aşağıdaki yapı ile kontrol edebilirsiniz.

Sub Ag_Surucu_Listele()
'Dim Wsh As WshNetwork, a As String

Set Wsh = CreateObject("Wscript.Network")
'Önce sürücü adı(döngüde çift sayı), sonra paylaşım yolu(tek sayı) düzeniyle listeleniyor.
'Ör: i = 0 => "Z:",   i = 1 => "\\yesilsy\SharedDocs"

    For i = 0 To Wsh.EnumNetworkDrives.Count - 1 Step 2
         a = a & "Sürücü Adı: " & Wsh.EnumNetworkDrives(i) & _
             ",  Paylaşım: " & Wsh.EnumNetworkDrives(i + 1) & Chr(10)
    Next
     
     MsgBox a

End Sub

 

[S.Yiğit]

Hocam öncelikle teşekkürler.. Benim ihtiyacım kontrolden ziyade ben çalışırken her kaydettiğimizde yedek alınıyor. Yoğun dönemlerde evden de çalışmam gerekiyor. İşyerinde herhangi bir sıkıntım yok ama evden çalıştığımda yolu bulamadığı için hata veriyor, böyle durumlar için kodu revize etmemiz lazım Z yolunu bulamadıgında Y yoluna kaydetmeli

 

[Zeki Gürsoy]

Basit bir hata denetimi ile de yapmak mümkün. Değişiklikler koyu fonttadır.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
Dim d() As String, [B]dosyaZ As String, dosyaY As String[/B], dosyaAdı As String, uzantı As String
 
[B]On Error Resume Next[/B]

With ActiveWorkbook
    d = Split(.Name, ".")
    uzantı = d(UBound(d))
    dosyaAdı = Left(.Name, Len(.Name) - Len(uzantı) - 1)
 
    [B]dosyaZ = "Z:\SAHA HIZMETLERI\FAYDALI BILGILER\yedekler\Montaj Takibi\Montaj Takibi ve Planlama Çizelgesi" & _
        Format(Now, " dd.mm.yyyy_hh/mm/ss") & "." & uzantı[/B]
        
    [B]dosyaY = "Y:\SAHA HIZMETLERI\FAYDALI BILGILER\yedekler\Montaj Takibi\Montaj Takibi ve Planlama Çizelgesi" & _
        Format(Now, " dd.mm.yyyy_hh/mm/ss") & "." & uzantı[/B]
 
    .SaveCopyAs Filename:=[B]dosyaZ[/B]
    
   [B] If Err Then .SaveCopyAs Filename:=dosyaY[/B]
End With
 
End Sub

 

[S.Yiğit]

Hocam yardımınız için teşekkürler.. Hazır konusu açılmışken bir konuda daha yardıma ihitiyacım var.. Kodda kırmızıya boyadığım yeri mevcut sayfanın adını yazdırmak mümkün mü? Çünkü ben bu kodu 3-4 çalışma için kullanacam.

Örnek dosya ismi planlama diyelim.. planlama 19.02.2011_20.37.19 şeklinde kaydetmeli

dosyaZ = "Z:\SAHA HIZMETLERI\FAYDALI BILGILER\yedekler\Montaj Takibi\[COLOR="Red"]Montaj Takibi ve Planlama Çizelgesi[/COLOR]" & _
        Format(Now, " dd.mm.yyyy_hh/mm/ss") & "." & uzantı
        
dosyaY = "Y:\SAHA HIZMETLERI\FAYDALI BILGILER\yedekler\Montaj Takibi\[COLOR="red"]Montaj Takibi ve Planlama Çizelgesi[/COLOR]" & _
        Format(Now, " dd.mm.yyyy_hh/mm/ss") & "." & uzantı

 

[Zeki Gürsoy]

Çalışılan dosya adını veren "WbName" isimli fonk.hazırladım.

Function WbName() As String
[COLOR=DarkGreen]'2007 için .xlsx veya .xlsm[/COLOR]
    WbName = Replace(ThisWorkbook.Name, ".xls", "")
End Function

dosyaZ = "Z:\SAHA HIZMETLERI\FAYDALI BILGILER\yedekler\Montaj Takibi\" & [B]WbName[/B] & _
        Format(Now, " dd.mm.yyyy_hh/mm/ss") & "." & uzantı
        
dosyaY = "Y:\SAHA HIZMETLERI\FAYDALI BILGILER\yedekler\Montaj Takibi\" & [B]WbNam[/B]e & _
        Format(Now, " dd.mm.yyyy_hh/mm/ss") & "." & uzantı

 

[S.Yiğit]

Hocam çok teşekkür ederim, Elinize sağlık.. Dosya ismine m harfini ekliyor.

planlamam 19.02.2011_20.37.19 gibi.

Ben 2007 kullanıyorum.. ama bu haliylede kullanırım sorun değil.. İyi akşamlar dilerim..

 

[Zeki Gürsoy]

Fonksiyon aceleye gelmişti.

Madem ki öyle, kullanışlı olsun bari. "WbName" fonksiyonunu aşağıdaki ile değiştirin.

Function WbName() As String
    
    WbName = Left$(ThisWorkbook.Name, _
            InStrRev(ThisWorkbook.Name, ".x") - 1)
End Function

 

[S.Yiğit]

Estağfurullah hocam Çok güzel oldu, elinize sağlık.. Tekrar iyi akşamlar dilerim