2017-10-12 281 views
0

我在搜索多個ServerShare時運行「NetworkObject.MapNetworkDrive」時遇到了一些問題。如果ServerShare PC處於在線狀態,則代碼工作正常,並且其響應時間低於5秒,但是當ServerShare PC處於脫機狀態時,代碼將超時30秒(默認超時)。我已經爲運行時錯誤設置了錯誤處理。爲NetworkObject.MapNetworkDrive設置超時時間

是否有任何代碼在「NetworkObject.MapNetworkDrive」上設置超時5秒?

我在域上有超過300個ServerShare PC。

這裏是我的代碼:

Private Sub pbCheck_Click() 

i = 12 
Do 
    If Sheets("Update Checker").Cells(2, 8) <> "" And Sheets("Update Checker").Cells(i, 10) <> "" Then 
     ServerShare = "\\" & Sheets("Update Checker").Cells(i, 10) & "\c$\Windows\servicing\Packages" 
     UserName = Sheets("Update Checker").Cells(i, 10) & "\Administrator" 
     Password = "[email protected]" 

    Set NetworkObject = CreateObject("WScript.Network") 
    Set FSO = CreateObject("Scripting.FileSystemObject") 

    On Error GoTo ErrCol 
    NetworkObject.MapNetworkDrive "", ServerShare, False, UserName, Password 

    Test = "\\" & Sheets("Update Checker").Cells(i, 10) & "\c$\Windows\servicing\Packages\" & "*" & Sheets("Update Checker").Cells(2, 8) & "*" & ".cat" 

    If Dir(Test) <> "" Then 
     Sheets("Update Checker").Cells(i, 11) = "OK" 
    Else 
     Sheets("Update Checker").Cells(i, 11) = "X" 
    End If 

    Set Filename = Nothing 
    Set Directory = Nothing 
    Set FSO = Nothing 

    NetworkObject.RemoveNetworkDrive ServerShare, True, False 

    Set ShellObject = Nothing 
    Set NetworkObject = Nothing 

End If 
NextCol: 
    i = i + 1 
    Loop Until Sheets("Update Checker").Cells(i, 10) = "" 

ErrCol: 
Resume NextCol 

End Sub 

我的代碼停留在NetworkObject.MapNetworkDrive "", ServerShare, False, UserName, Password 30秒,如果PC處於脫機狀態。

謝謝。

+0

可能使用** ** FSO.FolderExists到'MapNetworkDrive'前檢查'ServerShare'的根文件夾存在嗎? – PatricK

+0

@PatricK感謝您的回覆,但是當我在'MapNetworkDrive'之前放置'FSO.FolderExists'時,問題仍然存在。默認TimeOut停留在'FSO.FolderExists'。有沒有任何代碼可以將默認Runtime/TimeOut設置爲5秒? – Falhuddin

回答

0

我已經解決了這個問題。我正在運行PING命令來檢查PC在線或離線,它需要4秒鐘檢查每臺PC併爲在線和離線PC創建Select Case。在這裏我的代碼。

Private Sub pbCheck_Click() 

i = 12 
Do 
    If Sheets("Update Checker").Cells(2, 8) <> "" And Sheets("Update Checker").Cells(i, 10) <> "" Then 
     ServerShare = "\\" & Sheets("Update Checker").Cells(i, 10) & "\c$\Windows\servicing\Packages" 
     UserName = Sheets("Update Checker").Cells(i, 10) & "\Administrator" 
     Password = "[email protected]" 

     Set NetworkObject = CreateObject("WScript.Network") 
     Set FSO = CreateObject("Scripting.FileSystemObject") 

     Test = "\\" & Sheets("Update Checker").Cells(i, 10) & "\c$\Windows\servicing\Packages\" & "*" & Sheets("Update Checker").Cells(2, 8) & "*" & ".cat" 

     hostname = Sheets("Update Checker").Cells(i, 10) 
     Set WshShell = CreateObject("WScript.Shell") 
     Ping = WshShell.Run("ping -n 1 " & hostname, 0, True) 
     Select Case Ping 
     Case 0 

      On Error GoTo ErrCol 
      NetworkObject.MapNetworkDrive "", ServerShare, False, UserName, Password 

      If Dir(Test) <> "" Then 
       Sheets("Update Checker").Cells(i, 11) = "OK" 
      Else 
       Sheets("Update Checker").Cells(i, 11) = "X" 
      End If 

      Set Filename = Nothing 
      Set Directory = Nothing 
      Set FSO = Nothing 

      NetworkObject.RemoveNetworkDrive ServerShare, True, False 

      Set ShellObject = Nothing 
      Set NetworkObject = Nothing 

     Case 1 
      GoTo NextCol 
     End Select 
    End If 
NextCol: 
    i = i + 1 
Loop Until Sheets("Update Checker").Cells(i, 10) = "" 

Exit Sub 

ErrCol: 
Resume NextCol 

End Sub 
+0

您還可以添加'-w#',其中#是毫秒以等待回覆以縮短等待時間。取決於您的網絡延遲,因此請測試最佳安全時間。 – PatricK