我已经自动化了一些任务，其中涉及用Excel信息填充一些框。一切正常，除了宏完成时IE崩溃并停止响应并重新加载网站的事实。
为什么会发生这种情况？
Sub automateIE()
Dim wkb1 As Workbook
Dim ws1, ws2, ws3 As Worksheet
Set ws1 = Sheets("ws1")
Dim ieApp As SHDocVw.InternetExplorer
Set ieApp = IEWindowFromTitle("website title") 'this is a formula I'm using from someone else and it's after this code
If Not ieApp Is Nothing Then
Set ieDoc = ieApp.document
End If
ws2.Activate
If ws2.Range("A6").Value <> "" Then
If ws2.Range("A6").Offset(1).Value = "" Then
additems = 1
GoTo add_items 'if I want to exit the for loop with "Exit For" IE crashes too so I chenged it to GoTo
ElseIf ws2.Range("A6").Offset(2).Value = "" Then
additems = 2
GoTo add_items
Else
additems = ws2.Range(Range("A6"), Range("A6").End(xlDown)).Cells.Count
GoTo add_items
End If
End If
ws3.Activate
If ws3.Range("A6").Value <> "" Then
If ws3.Range("A6").Offset(1).Value = "" Then
additems = 1
ElseIf ws3.Range("A6").Offset(2).Value = "" Then
additems = 2
Else
additems = ws3.Range(Range("A6"), Range("A6").End(xlDown)).Cells.Count
End If
End If
add_items:
Dim additemsbtn As HTMLDivElement
Set additemsbtn = ieDoc.getElementById("MI_AddItem")
Dim aNodeList As Object
Dim itemName As HTMLDivElement
Dim savebtn As HTMLDivElement
additemsbtn.Click
Set aNodeList = ieDoc.querySelectorAll("[dojoinsertionindex]")
Application.Wait (Now + TimeValue("0:00:01"))
Dim repeatadd As Variant
Dim rest As Integer
repeatadd = (additems / 5)
Dim roundvalue() As String
roundvalue() = Split(repeatadd, ",")
If additems < 6 Then
For i = 0 To additems
If aNodeList.Item(i).innerText Like additems Then
aNodeList.Item(i).Click
Application.Wait (Now + TimeValue("0:00:01"))
Exit For
End If
Next i
Else
If additems Mod 5 = 0 Then
For i = 1 To repeatadd
aNodeList.Item(4).Click
Application.Wait (Now + TimeValue("0:00:01"))
Next i
Else
If additems < 75 Then
rest = additems Mod 5
For i = 1 To roundvalue(0)
aNodeList.Item(4).Click
Application.Wait (Now + TimeValue("0:00:01"))
Next i
For i = 0 To rest
If aNodeList.Item(i).innerText Like rest Then
aNodeList.Item(i).Click
Application.Wait (Now + TimeValue("0:00:01"))
End If
Next i
ElseIf additems >= 75 And additems < 100 Then
ieDoc.getElementsByName("pageSize")(0).Value = 100
ieDoc.getElementById("navlist").Click
rest = additems Mod 5
For i = 1 To roundvalue(0)
aNodeList.Item(4).Click
Application.Wait (Now + TimeValue("0:00:01"))
Next i
For i = 0 To rest
If aNodeList.Item(i).innerText Like rest Then
aNodeList.Item(i).Click
Application.Wait (Now + TimeValue("0:00:01"))
End If
Next i
End If
End If
End If
Dim element As Object
Dim loopaux As Integer
Dim loopexit As Integer
Dim valueaux As String
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
End If
'FROM HERE
For Each element In ieDoc.querySelectorAll("select")
If element.Name Like "itemLevelCustomFieldValue*" Then
Else: GoTo nextelement
End If
If element.Value <> "JJTMS" Then
element.Focus
element.Value = "something"
element.FireEvent ("onchange")
loopaux = loopaux + 1
If loopaux = additems Then
GoTo exitfor
End If
End If
nextelement:
Next element
exitfor:
loopaux = 0
loopexit = 6
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
'FROM HERE
For Each element In ieDoc.querySelectorAll("select")
If element.Name Like "lineItemCategoryId*" Then
element.Focus
If element.Name = valueaux Then
GoTo nextelement1
End If
If element.Name <> valueaux Then
For i = 6 To 6 + additems
element.Value = ws2.Range("AE" & i).Value
If loopexit = i Then Exit For
Next i
element.FireEvent ("onchange")
loopaux = loopaux + 1
loopexit = loopexit + 1
valueaux = element.Name
End If
If loopaux = additems Then
GoTo exitfor1
End If
End If
nextelement1:
Next element
exitfor1:
loopaux = 0
loopexit = 6
iSubcat = 6
'TO HERE. This part of the code repeats four times but taking information from other columns o
'copy to current
For Each element In ieDoc.querySelectorAll("input")
If InStr(1, element.outerHTML, "javascript:selectAll(this, 'selectedLineItems');") > 0 Then
element.Click
element.FireEvent ("onclick")
GoTo exitfor7
End If
Next element
exitfor7:
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
ieDoc.getElementById("/images/buttons/save.gif").Click
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
Dim copytocurrent1 As HTMLDivElement
Set copytocurrent1 = ieDoc.getElementById("MI_Column_1")
Dim copytocurrent2 As Object
copytocurrent1.Click
For Each element In ieDoc.querySelectorAll("span.dojoMenuItem2Label")
If element.innerText Like "Current" Then
element.Click
element.FireEvent ("onclick")
GoTo exitfor8
End If
Next element
exitfor8:
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
ieDoc.getElementById("/images/buttons/save.gif").Click
Application.Wait (Now + TimeValue("0:00:01"))
ieDoc.getElementById("2473").getElementsByTagName("a")(0).Click
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
UserForm1.Show
Set GMF = Workbooks(GMFname)
GMF.Activate
For Each element In ieDoc.querySelectorAll("select")
If element.innerText Like "LOW SAVINGS*" Then
Call Savings
element.Value = savings_comment
GoTo exitfor10
End If
Next element
exitfor10:
Application.Wait (Now + TimeValue("0:00:01"))
'Repeats las loop five more times for different boxes
ieDoc.getElementById("/images/buttons/save.gif").Click
Application.Wait (Now + TimeValue("0:00:01"))
'it gets here, does everything in the code and then crashes
End Sub
Public Function IEWindowFromTitle(sTitle As String) As SHDocVw.InternetExplorer
Dim objShellWindows As New SHDocVw.ShellWindows
Dim win As Object, rv As SHDocVw.InternetExplorer
For Each win In objShellWindows
If TypeName(win.document) = "HTMLDocument" Then
If UCase(win.document.Title) = UCase(sTitle) Then
Set rv = win
Exit For
End If
End If
Next
Set IEWindowFromTitle = rv
End Function
在代码中，某些名称已更改为通用名称，而某些重复的部分已删除。
Sub automateIE()
Dim wkb1 As Workbook
Dim ws1, ws2, ws3 As Worksheet
Set ws1 = Sheets("ws1")
Dim ieApp As SHDocVw.InternetExplorer
Set ieApp = IEWindowFromTitle("website title") 'this is a formula I'm using from someone else and it's after this code
If Not ieApp Is Nothing Then
Set ieDoc = ieApp.document
End If
ws2.Activate
If ws2.Range("A6").Value <> "" Then
If ws2.Range("A6").Offset(1).Value = "" Then
additems = 1
GoTo add_items 'if I want to exit the for loop with "Exit For" IE crashes too so I chenged it to GoTo
ElseIf ws2.Range("A6").Offset(2).Value = "" Then
additems = 2
GoTo add_items
Else
additems = ws2.Range(Range("A6"), Range("A6").End(xlDown)).Cells.Count
GoTo add_items
End If
End If
ws3.Activate
If ws3.Range("A6").Value <> "" Then
If ws3.Range("A6").Offset(1).Value = "" Then
additems = 1
ElseIf ws3.Range("A6").Offset(2).Value = "" Then
additems = 2
Else
additems = ws3.Range(Range("A6"), Range("A6").End(xlDown)).Cells.Count
End If
End If
add_items:
Dim additemsbtn As HTMLDivElement
Set additemsbtn = ieDoc.getElementById("MI_AddItem")
Dim aNodeList As Object
Dim itemName As HTMLDivElement
Dim savebtn As HTMLDivElement
additemsbtn.Click
Set aNodeList = ieDoc.querySelectorAll("[dojoinsertionindex]")
Application.Wait (Now + TimeValue("0:00:01"))
Dim repeatadd As Variant
Dim rest As Integer
repeatadd = (additems / 5)
Dim roundvalue() As String
roundvalue() = Split(repeatadd, ",")
If additems < 6 Then
For i = 0 To additems
If aNodeList.Item(i).innerText Like additems Then
aNodeList.Item(i).Click
Application.Wait (Now + TimeValue("0:00:01"))
Exit For
End If
Next i
Else
If additems Mod 5 = 0 Then
For i = 1 To repeatadd
aNodeList.Item(4).Click
Application.Wait (Now + TimeValue("0:00:01"))
Next i
Else
If additems < 75 Then
rest = additems Mod 5
For i = 1 To roundvalue(0)
aNodeList.Item(4).Click
Application.Wait (Now + TimeValue("0:00:01"))
Next i
For i = 0 To rest
If aNodeList.Item(i).innerText Like rest Then
aNodeList.Item(i).Click
Application.Wait (Now + TimeValue("0:00:01"))
End If
Next i
ElseIf additems >= 75 And additems < 100 Then
ieDoc.getElementsByName("pageSize")(0).Value = 100
ieDoc.getElementById("navlist").Click
rest = additems Mod 5
For i = 1 To roundvalue(0)
aNodeList.Item(4).Click
Application.Wait (Now + TimeValue("0:00:01"))
Next i
For i = 0 To rest
If aNodeList.Item(i).innerText Like rest Then
aNodeList.Item(i).Click
Application.Wait (Now + TimeValue("0:00:01"))
End If
Next i
End If
End If
End If
Dim element As Object
Dim loopaux As Integer
Dim loopexit As Integer
Dim valueaux As String
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
End If
'FROM HERE
For Each element In ieDoc.querySelectorAll("select")
If element.Name Like "itemLevelCustomFieldValue*" Then
Else: GoTo nextelement
End If
If element.Value <> "JJTMS" Then
element.Focus
element.Value = "something"
element.FireEvent ("onchange")
loopaux = loopaux + 1
If loopaux = additems Then
GoTo exitfor
End If
End If
nextelement:
Next element
exitfor:
loopaux = 0
loopexit = 6
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
'FROM HERE
For Each element In ieDoc.querySelectorAll("select")
If element.Name Like "lineItemCategoryId*" Then
element.Focus
If element.Name = valueaux Then
GoTo nextelement1
End If
If element.Name <> valueaux Then
For i = 6 To 6 + additems
element.Value = ws2.Range("AE" & i).Value
If loopexit = i Then Exit For
Next i
element.FireEvent ("onchange")
loopaux = loopaux + 1
loopexit = loopexit + 1
valueaux = element.Name
End If
If loopaux = additems Then
GoTo exitfor1
End If
End If
nextelement1:
Next element
exitfor1:
loopaux = 0
loopexit = 6
iSubcat = 6
'TO HERE. This part of the code repeats four times but taking information from other columns o
'copy to current
For Each element In ieDoc.querySelectorAll("input")
If InStr(1, element.outerHTML, "javascript:selectAll(this, 'selectedLineItems');") > 0 Then
element.Click
element.FireEvent ("onclick")
GoTo exitfor7
End If
Next element
exitfor7:
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
ieDoc.getElementById("/images/buttons/save.gif").Click
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
Dim copytocurrent1 As HTMLDivElement
Set copytocurrent1 = ieDoc.getElementById("MI_Column_1")
Dim copytocurrent2 As Object
copytocurrent1.Click
For Each element In ieDoc.querySelectorAll("span.dojoMenuItem2Label")
If element.innerText Like "Current" Then
element.Click
element.FireEvent ("onclick")
GoTo exitfor8
End If
Next element
exitfor8:
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
ieDoc.getElementById("/images/buttons/save.gif").Click
Application.Wait (Now + TimeValue("0:00:01"))
ieDoc.getElementById("2473").getElementsByTagName("a")(0).Click
If additems > 20 Then
Application.Wait (Now + TimeValue("0:00:05"))
Else
Application.Wait (Now + TimeValue("0:00:01"))
End If
UserForm1.Show
Set GMF = Workbooks(GMFname)
GMF.Activate
For Each element In ieDoc.querySelectorAll("select")
If element.innerText Like "LOW SAVINGS*" Then
Call Savings
element.Value = savings_comment
GoTo exitfor10
End If
Next element
exitfor10:
Application.Wait (Now + TimeValue("0:00:01"))
'Repeats las loop five more times for different boxes
ieDoc.getElementById("/images/buttons/save.gif").Click
Application.Wait (Now + TimeValue("0:00:01"))
'it gets here, does everything in the code and then crashes
End Sub