בדיקה אם קיימת תיקיה ברשת - VBA

yits

אני משתמש כיום בפונקציה הבאה, והיא עובדת מצוין לתיקיות מקומיות אבל בכתובת רשת או מחשב ברשת אם הכתובת לא תקינה זה במקרה הטוב לוקח הרבה זמן, ולפעמים גם לא עובד.

if Len(Dir("\\10.0.0.1\Folder", vbDirectory)) <> 0 = False Then

ויש אפשרות להשתמש עם סקריפט והוא מחזיר תשובה, וכשהכתובת לא תקינה זה לקח לי חצי דקה עד שקיבלתי תשובה.

Sub Main()
  Dim fso As Object
  Set fso = CreateObject("scripting.filesystemobject")
  With fso
    MsgBox .FileExists("\\10.0.0.1\Folder\ReadMe.txt")
    MsgBox .FolderExists("\\10.0.0.1\Folder")
  End With
  Set fso = Nothing
End Sub

האם יש דרך קצרה לבדוק תיקיה משותפת ברשת?

yits

מצאתי פתרון (אני מעלה לכאן לאחרים שיחפשו תשובה).
הוספתי Debug.Print Time כדי לראות כמה זמן זה לוקח.
וזה לקח לי בערך 3 שניות.

Function SystemOnline(ByVal ComputerName As String)
Debug.Print Time
    ' This function returns True if the specified host could be pinged.
    ' HostName can be a computer name or IP address.
    ' The Win32_PingStatus class used in this function requires Windows XP or later.
    ' Standard housekeeping
    Dim colPingResults As Variant
    Dim oPingResult As Variant
    Dim strQuery As String
    ' Define the WMI query
    strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & ComputerName & "'"
    ' Run the WMI query
    Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
    ' Translate the query results to either True or False
    For Each oPingResult In colPingResults
        If Not IsObject(oPingResult) Then
            SystemOnline = False
        ElseIf oPingResult.StatusCode = 0 Then
            SystemOnline = True
        Else
            SystemOnline = False
        End If
    Next
Debug.Print Time
End Function

תחומים - פורום חרדי מקצועי

בדיקה אם קיימת תיקיה ברשת - VBA