Ağ üzerindeki excel dosyayı açmak-kaydetmek

[Ergün Güler]

Selam,
aşağıdaki kodlar ile, ANA EXCEL Dosyam açılırken ile şifreli excel dosyasını açıyor, işlem yapıyor, kaydediyor ve kapatıyorum. Aynı işlemi ANA EXCEL Dosyam kapanırken de yapıyorum. Zaman zaman bir çok sıkıntılar oluyor. daha sağlıklı, alternatif olarak başka türlü nasıl yapabilirim?

Private Sub Workbook_Open()
Excel.Application.WindowState = xlMaximized
anasayfa.Show
Call oturum_kaydet1
End Sub

Sub oturum_kaydet1() 'başlangıç
    Application.Visible = False
    Application.ScreenUpdating = False
    
    On Error Resume Next
    For j = 1 To Workbooks.Count
    If Workbooks(j).Name = "DOSYA.xls" Then GoTo atla1
    Next
    Workbooks.Open Filename:="\\XX.XX.XX.XX\DOSYA_YOLU\DOSYA.xls", Password:="xxxx"
atla1:
Windows("DOSYA.xls").Activate
    Dim fo As Worksheet
    Set fo = Sheets("kullanıcı")
    son_sat = fo.Range("A65536").End(3).Row
   
    fo.Cells(son_sat + 1, "A") = Environ("username")
    fo.Cells(son_sat + 1, "B") = Now
    fo.Cells(son_sat + 1, "C") = ThisWorkbook.Name
    fo.Cells(son_sat + 1, "D") = ThisWorkbook.Path
    fo.Cells(son_sat + 1, "E") = "başlagıç"
    Windows("DOSYA.xls").Close True
    Application.ScreenUpdating = True
    Application.Visible = True
End Sub

Private Sub CommandButton18_Click()
If MsgBox("Programını Kapatmak İstediğinize Emin misiniz?", vbExclamation + vbYesNo, "KAPATMA İŞLEMİ") <> vbYes Then Exit Sub

Call oturum_kaydet2
Application.Windows(ThisWorkbook.Name).ActivateNext
ThisWorkbook.Close False
End Sub

Sub oturum_kaydet2() 'bitiş
    Application.Visible = False
    Application.ScreenUpdating = False
    
    On Error Resume Next
    For j = 1 To Workbooks.Count
    If Workbooks(j).Name = "DOSYA.xls" Then GoTo atla2
    Next
    Workbooks.Open Filename:="\\XX.XX.XX.XX\DOSYA_YOLU\DOSYA.xls", Password:="xxxx"
atla2:
Windows("DOSYA.xls").Activate
    Dim fo As Worksheet
    Set fo = Sheets("kullanıcı")
    son_sat = fo.Range("A65536").End(3).Row
   
    fo.Cells(son_sat + 1, "A") = Environ("username")
    fo.Cells(son_sat + 1, "B") = Now
    fo.Cells(son_sat + 1, "C") = ThisWorkbook.Name
    fo.Cells(son_sat + 1, "D") = ThisWorkbook.Path
    fo.Cells(son_sat + 1, "E") = "bitiş"
    Windows("DOSYA.xls").Close True
    Application.ScreenUpdating = True
    Application.Visible = True
End Sub

Yardımcı olabilirseniz çok sevinirim.

 

[Ergün Güler]

Selam,
Yardımcı olabilir misiniz?

 

[Ergün Güler]

Selam,
Yardımcı olabilecek kimse var mı?

 

[Korhan Ayhan]

Selamlar,

Ergün bey zaman zaman sıkıntılar oluyor demişsiniz fakat detaylı açıklama yapmamışsınız. Sanıyorum bu sebeple sorunuz yanıtsız kalmış.

Yaşadığınız sıkıntıyı belirtirseniz belki çözüm yolları önerebiliriz.