Soru Workbooks open olayı???

[sefa044]

Arkadaşlar
workbooks open ("Z:asp.xlsm")
Kodu var makromda.
Kodu çalıştırdığımda ortak ağda dosyayı arıyor. eğer dosyayı bulabiliyorsa açıyor. Eğer bulamazsa arıyor arıyor en sonunda excel çöküyor.
İsteğim şu, ilk önce internet bağlantım var mı yok mu (Z ye erişebiliyor muyum?) kontrol etsin. İnternet yoksa yada 3sn boyunca dosyayı Z de arayıp bulamazsa msgbox verip makroyu bitirsin.
Teşekkürler.

 

[yanginci34]

Örnek dosya yüklerseniz ustalar daha kolay yardımcı olacaktır

 

[Korhan Ayhan]

Deneyiniz.

If Dir("Dosya Yolunuz") <> "" Then
WorkBooks.Open("Dosya Yolunuz")
Else
MsgBox "Dosya bulunamadı!"
End If

 

[sefa044]

Tşk deneyeceğim.

 

[Zeki Gürsoy]

Bunun bir diğer yolu da WScript nesnesidir. Bu nesne ile ağ köprüsü denetlenebilir, eklenebilir veya silinebilir.

https://excelturkey.com/konu/wscript-network-wscript-shell-metot-ve-ozellikleri.522/

 

[sefa044]

Deneyiniz.

If Dir("Dosya Yolunuz") <> "" Then
WorkBooks.Open("Dosya Yolunuz")
Else
MsgBox "Dosya bulunamadı!"
End If

Korhan bey kod çalışmadı. if dir satırında debug veriyor.

 

[Erdem Akdemir]

Bunun bir diğer yolu da WScript nesnesidir. Bu nesne ile ağ köprüsü denetlenebilir, eklenebilir veya silinebilir.

https://excelturkey.com/konu/wscript-network-wscript-shell-metot-ve-ozellikleri.522/

@ZEKİ bey yine çok faydalı bir çalışma olmuş.Elinize aklınıza sağlık.

 

[Korhan Ayhan]

Uyguladığınız kodu paylaşır mısınız?

 

[sefa044]

Uyguladığınız kodu paylaşır mısınız?

Sub YENİ_ÜYE_KAYDET()
Application.ScreenUpdating = False
Application.EnableEvents = False

basla = Time

'DEĞİŞKEN ATAR
Dim bukitap As Workbook
Set bukitap = ThisWorkbook
'BİLGİLERİ KAYNAK DOSYAYA GÖNDERİR
bukitap.Activate
Sheets("GİRİŞ").Select
Range("B25:G25").Select
Selection.Copy

'KAYNAK DOSYAYI AÇAR
If Dir("Z:\1- İHALE EXCEL DOSYALARI_SİLMEYİN\Komisyon Üyeleri_SİLMEYİN.xlsm") <> "" Then 'ORTAK: / İNTERNET VAR MI KONTROL EDER

Workbooks.Open Filename:="Z:\1- İHALE EXCEL DOSYALARI_SİLMEYİN\Komisyon Üyeleri_SİLMEYİN.xlsm"

On Error GoTo 0 'BURDAN SONRA HATALARI DİKKATE AL
Windows("Komisyon Üyeleri_SİLMEYİN.xlsm").Activate
Sheets("Sayfa1").Select
Range("K5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Rows("10:10").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Range("K6").Select
ActiveCell.FormulaR1C1 = "=PROPER(R[-1]C)"
Range("L6").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("M6").Select
ActiveCell.FormulaR1C1 = "=PROPER(R[-1]C)"

Range("K7").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"" "",R[-1]C[1])"

Range("K7").Select
Selection.Copy
Range("A10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("M6").Select
Selection.Copy
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("C1").Select

Range("P5").Select 'TEL NO kaydı yapar
Selection.Copy
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("C1").Select

Columns("A:C").Select
Range("A34").Activate
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range("A1:A9999") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sayfa1").Sort
.SetRange Range("A1:C9999")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:C").Select
ActiveSheet.Range("$A$1:$C$9999").RemoveDuplicates Columns:=1, Header:=xlNo
Range("D1").Select

Columns("K").Select
Selection.Delete Shift:=xlToLeft
Columns("A:C").Select
Selection.Copy
'ANA DOSYAYA DÖNER
bukitap.Activate
Sheets("GİRİŞ").Select
Sheets("Veriler").Visible = True
Sheets("Veriler").Select
Columns("A:C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E24").Select
Application.CutCopyMode = False
'KAYNAĞI KAYDEDER KAYNAĞI KAPATIR
Windows("Komisyon Üyeleri_SİLMEYİN.xlsm").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close True
Application.DisplayAlerts = True
'ANA DOSYAYA DÖNER
bukitap.Activate
Sheets("Veriler").Select
ActiveWindow.SelectedSheets.Visible = False
Range("B25:G25,S25").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A23").Select


bitis = Time
CreateObject("WScript.Shell").PopUp "ORTAK' A KAYIT BAŞARILI." & Chr(10) & "" & Chr(10) & "" & Chr(10) & _
"İşlem Süresi: " & Format(bitis - basla, "ss") & " sn", 2, "Otomatik Mesaj", vbOKOnly + vbInformation 'OTOMATİK KAPANAN (2 SN) ve İŞLEM SÜRESİ BİLDİREN MESAJ KUTUSU

Else

Application.CutCopyMode = False
Beep
MsgBox "Ortak'a Ulaşılamıyor.!!" & Chr(10) & "İnternet Yok.!!"
Range("A23").Select

End If

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub