我被赋予了使用VBScript在Macro Express中创建宏来从一个基于Internet Explorer的平台复制数据并将其粘贴到另一个基于IE的平台的任务。下面的代码在我的电脑上完美运行。它在远程桌面环境中也能很好地工作。一些正在测试它的用户说它工作正常。其他人说它冻结了他们的电脑并且没有做任何事情。这是代码：
Option Explicit
Dim WShell, objShell, objShellWindows, objIE, URL, Window, URLFound, objOption
Dim Error, errormsg, intSpaceLoc, intParenLoc
Dim i, U, strName, strOutput, strFName, strLName, strEmployer, strMessage
On Error Resume Next
Set WShell = CreateObject("WScript.Shell")
Set objIE = CreateObject("InternetExplorer.Application")
If Err.Number <> 0 Then ShowError("It Failed")
On Error Goto 0
Claims_Search
Claims_Open
Modify_Search
Set WShell = Nothing
Set objShell = Nothing
Set objShellWindows = Nothing
Set objIE = Nothing
'----------------------------
Sub ShowError(strMessage)
WScript.Echo strMessage
WScript.Echo "Error number: " & Err.Number & vbNewline & "Source: " & Err.Source & vbNewline & "Description: " & Err.Description
Err.Clear
End Sub
'------------------------------
Sub Claims_Search()
URL = "http://claims.url.com"
U = Len(URL)
Window = "Claim"
Check_URL
End Sub
'-----------------------------
Function Check_URL()
Set objShell = CreateObject("Shell.Application")
Set WShell = CreateObject("WScript.Shell")
URLFound = False
On Error Resume Next
Set objShellWindows = objShell.Windows
If Err.Number <> 0 Then ShowError("It Failed")
On Error Goto 0
For Each objIE In objShell.Windows
Next
For i = 0 To objShellWindows.Count - 1
Set objIE = objShellWindows.Item(i)
On Error Resume Next
If Left(objShellWindows.Item(i).LocationURL, U) = (URL) Then
If InStr(UCase(objShellWindows.Item(i).FullName), "IEXPLORE.EXE") Then
If Err.Number = 0 Then
If InStr(objShellWindows.Item(i).Document.Title, (Window)) Then
URLFound = True
Exit For
End If
End If
End If
End If
Next
If URLFound = False Then
Set objIE = CreateObject("InternetExplorer.Application")
ErrorHandling
End If
End Function
'------------------------------------
Function Claims_Open()
objIE.Visible = True
strName = objIE.Document.all.Item("ParticipantNameLink").innerText
intSpaceLoc = InStr(strName, " ")
strFName = Left(strName, intSpaceLoc)
strLName = Replace(strName, strFName, "")
strEmployer = objIE.Document.all.Item("Employer").innerText
If InStr(strEmployer, "(") <> 0 Then
intParenLoc = InStr(strEmployer, "(")
strEmployer = Left(strEmployer, intParenLoc - 2)
End If
Wait_Webpage
Exit Function
End Function
'-------------------------------
Sub Modify_Search()
Set WShell = CreateObject("WScript.Shell")
Window = "Non-Keyable Document Management System :: Modify Index"
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
For Each objIE In objShell.Windows
Next
For i = 0 To objShellWindows.Count - 1
Set objIE = objShellWindows.Item(i)
On Error Resume Next
If InStr(UCase(objShellWindows.Item(i).FullName), "IEXPLORE.EXE") Then
If Err.Number = 0 Then
If InStr(objShellWindows.Item(i).Document.Title, (Window)) Then
Exit For
End If
End If
End If
Next
objIE.Visible = True
Wait_Webpage
objIE.Document.all.Item("txtLName").Value = strLName
objIE.Document.all.Item("txtFName").Value = strFName
objIE.Document.all.Item("txtCName").Value = strEmployer
objIE.Document.all.Item("btn_submit").Click
End Sub
'--------------------------------
Sub ErrorHandling()
WScript.Echo "EXIT"
Err = MsgBox(ErrMsg, 48 + vbSystemModal, "ERROR")
Set WShell = Nothing
Set objShell = Nothing
Set objShellWindows = Nothing
Set objIE = Nothing
WScript.Quit
End Sub
'----------------------------
Sub Wait_Webpage()
While objIE.Busy = True
WScript.sleep 200
Wend
While objIE.ReadyState <> 4
WScript.sleep 200
Wend
While objIE.Document Is Nothing
WScript.sleep 200
Wend
End Sub
我希望有人能看到我不能做到的事情。为什么这个相同的代码适用于某些代码而不适用于其他代码是没有意义的。
答案 0 :(得分：1)
通常在这种挂起的情况下，存在与创建的COM对象交互引起的问题。尝试实施更多防故障解决方案。
以下是等待程序的示例：
Sub WaitIE(objIE, strId)
With objIE
' wait until IE and the page are ready
Do While .Busy Or Not .readyState = 4
WScript.Sleep 10
Loop
' wait until the DOM is ready
Do Until .document.readyState = "complete"
WScript.Sleep 10
Loop
' wait until the target Id node is ready
Do While TypeName(.document.getElementById(strId)) = "Null"
WScript.Sleep 10
Loop
End With
End Sub
尝试使用函数调用替换代码中的大量objShellWindows循环，下面的代码是我根据自己的需要从AutoIt调整一次的IEAttach()函数示例：
Dim oIE
Set oIE = IEAttach(".com", "instance", "")
If oIE Is Nothing Then
MsgBox "No matches"
Else
MsgBox oIE.LocationName
End If
Function IEAttach(sString, sMode, iInstance)
' adapted from AutoIt https://www.autoitscript.com/autoit3/docs/libfunctions/_IEAttach.htm
' If sMode or iInstance is empty string "" or invalid - it will be considered as default
' sMode allows some of the AutoIt version: "title", "url", "text", "html", "hwnd", "instance"
' @error and @extended flags are not implemented, if no matches - Nothing will be returned
Dim oDict, oWnd, oDocument
On Error Resume Next
Set oDict = CreateObject("Scripting.Dictionary")
Set IEAttach = Nothing
If Not IsNumeric(iInstance) Then iInstance = 1
If iInstance < 1 Then iInstance = 1
For Each oWnd In CreateObject("Shell.Application").Windows
Set oDocument = oWnd.Document
If Instr(TypeName(oDocument), "HTML") Then
Select Case LCase(sMode)
Case "title"
If Instr(oWnd.LocationName, sString) Then oDict.Add oDict.Count, oWnd
Case "url"
If Instr(oWnd.LocationURL, sString) Then oDict.Add oDict.Count, oWnd
Case "text"
If Instr(oDocument.body.innertext, sString) Then oDict.Add oDict.Count, oWnd
Case "html"
If Instr(oDocument.body.innerhtml, sString) Then oDict.Add oDict.Count, oWnd
Case "hwnd"
If oWnd.HWND = sString Then oDict.Add oDict.Count, oWnd
Case "instance"
oDict.Add oDict.Count, oWnd
Case Else
If Instr(oWnd.LocationName, sString) Then oDict.Add oDict.Count, oWnd
End Select
End If
Next
If oDict.Exists(iInstance - 1) Then Set IEAttach = oDict.Item(iInstance - 1)
End Function
您可以循环此函数调用，直到必要的IE窗口准备就绪。