اختبار اتصال محرك اقراص الشبكة

[خالدو]

السلام عليكم ورحمة الله وبركاته

الملف المرفق به كود عشان يختبر إن كان القرص الصلب على المشترك على الشبكة متوفر أم لا.

الكود لاستدعاء هذا الاختبار في Private Sub Workbook_Open لكن للأسف لا يعمل مش عارف ليه.

ممكن تساعدوني

جزاكم الله خيراً

Book1.rar

[طارق محمود]

السلام عليكم

الملف به كود وهو يعمل جيدا

Private Sub Workbook_Open()


Select Case CheckForNetwork


Case Is = True

Sheet1.Range("A1").Formula = "='g:\Accounts Payable\[File2222.xls]sheet1'!$A$20"

Workbooks.Open Range("A1").Value


Case Is = False

Set Wk = Workbooks.Add

ThisWorkbook.Close savechanges:=False

End Select

End Sub

وهذا الكود إذا أردت قرائته فعليك رفع أمان الماكرو للحد الأقصي حتي لاينفذ الماكرو ويعطله أولا لتقرؤه

وهو كما تعرف يختبر الاتصال بمحرك اقراص النت: G:\

إما ان يكون متصل Case Is = True فيفتح الملف المشار إليه

أو ليس متصلا Case Is = False فيغلق الملف وينهي الماكرو

وقد يكون القرص الصلب ليس G فسيغلق الملف وينهي الماكرو أيضا

[خالدو]

جزاك الله خيراً أخي طارق

المشكلة أن الكود أعلاه لا يفتح الملف اللي موجود في الرابط.

هذا الكود يعمل لو موجود في زر أو أي مكان آخر غير Open

الكود لا يفتح الملف المشار إليه في المعادلة هذه هي مشكلتي.

وأكرر الشكر لكم.

[طارق محمود]

السلام عليكم

لست متأكدا تماما ولكن جرب التالي

أضف سطر Option Explicit في أول الكود

وأضف سطر تعريف Dim wk As Workbook بعد بداية الكود للمتغير wk

سيكون الكود كالتالي (جرب وأخبرني)

Option Explicit

Function CheckForNetwork() As Boolean

  Dim wb As Workbook

  On Error Resume Next

  Set wb = Workbooks.Open("g:\Accounts Payable\FileL2222.xls", True, True)

  If Err.Number = 0 Then

	CheckForNetwork = True

  Else

	CheckForNetwork = False

  End If

End Function

Private Sub Workbook_Open()


'If Dir("g:\Accounts Payable") = "" Then ThisWorkbook.Close savechanges:=False

'If Dir("g:\Accounts Payable") = "" Then ThisWorkbook.Close savechanges:=False

Dim wk As Workbook

Select Case CheckForNetwork


Case Is = True

'Application.Wait "00:00:05"


'Sheet1.Range("A1").Formula = "='g:\Accounts Payable\[File2222.xls]sheet1'!$A$20"


Workbooks.Open Range("A1").Value


'Set myworkbook = Workbooks.Add


Case Is = False


Set wk = Workbooks.Add

ThisWorkbook.Close savechanges:=False

End Select


End Sub

تم تعديل فبراير 6, 2011 بواسطه TareQ M

[خالدو]

الملف المرفق يوضح نوعية الخطأ الذي يأتيني عند فتح الملف.

وشكراً

Error.bmp

[طارق محمود]

أعتقد ان الخطأ يعني أن إسم الملف أو المسار غير دقيق أو أنه غير موجود والله أعلم

افتح الملف المطلوب علي حدي

ثم F12 أو Save as

وانسخ اسم الملف اللي يطلع كماهو

وبالنسبة للمسار

من الإكسبلورر إذهب إلي مكان الملف بالظبط

انظر الصورة كمثال

[خالدو]

السلام عليكم ورحمة الله وبركاته

أخي طارق:

استخدمت نفس الكود في زر أمر CommandButton اشتغل تمام لكن مع workbook_open() حدثت المشكلة.

لا أعرف السبب.