为NetworkObject.MapNetworkDrive设置TimeOut

时间:2017-10-12 00:49:57

标签: excel vba excel-vba

在搜索多个ServerShare时,我遇到了运行“NetworkObject.MapNetworkDrive”的问题。如果ServerShare PC处于联机状态,则代码可以正常工作,并且响应时间不到5秒即可响应,但当ServerShare PC处于脱机状态时,代码将需要30秒才能超时(默认TimeOut)。我已经为运行时错误设置了错误处理。

是否有任何代码在“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 = "P@ssw0rd245"

    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

如果PC处于离线状态,我的代码会在NetworkObject.MapNetworkDrive "", ServerShare, False, UserName, Password停留30秒。

谢谢。

1 个答案:

答案 0 :(得分:0)

我已经解决了这个问题。我正在运行PING命令来检查PC在线或离线,它需要4秒钟来检查每台PC并为在线和离线PC创建db.foo.aggregate([ {$match: {"_id": 1}} ,{$project: {result: {$map: { input: "$headers.payload", as: "z", in: "$$z._id" }} }} ]); 。在这里我的代码。

Select Case