为NetworkObject.MapNetworkDrive设置超时时间

我在搜索多个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处于脱机状态。

谢谢。

来源

2017-10-12 Falhuddin

可能使用** ** FSO.FolderExists到'MapNetworkDrive'前检查'ServerShare'的根文件夹存在吗？ – PatricK

@PatricK感谢您的回复，但是当我在'MapNetworkDrive'之前放置'FSO.FolderExists'时，问题仍然存在。默认TimeOut停留在'FSO.FolderExists'。有没有任何代码可以将默认Runtime/TimeOut设置为5秒？ – Falhuddin

我已经解决了这个问题。我正在运行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

来源

2017-10-12 03:09:41 Falhuddin

您还可以添加'-w＃'，其中＃是毫秒以等待回复以缩短等待时间。取决于您的网络延迟，因此请测试最佳安全时间。 – PatricK

为NetworkObject.MapNetworkDrive设置超时时间

回答

相关问题