我的模块结束后 Internet-Explorer 不会关闭

M--*_*M-- 5 excel internet-explorer vba userform

我有这个从网站中提取数据的宏。我从用户那里得到输入。它可以正常工作,但 IE 不会关闭并占用所有内存。是否需要其他东西而不是IE.Quit

这是子。如您所见,我最后关闭了 IE。

Public Cancel As Boolean

Sub USGD()

Dim IE As Object
Dim iWsh As Worksheet
Dim link As String
Dim sDate As String
Dim eDate As String
Dim StationID As String
    
Cancel = False

With USGS
    .StartUpPosition = 0
    .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
    .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
    .Show
End With

If Cancel = True Then
    Unload USGS
    Exit Sub
End If

With ActiveWorkbook
    Set iWsh = .Sheets.Add(After:=.Sheets(.Sheets.Count))
End With

iWsh.Activate
iWsh.Range("A1").Select 'I know this is not efficient but works fine


 StationID = USGS.TextBox1.Text
'StationID = InputBox("Please enter the station ID")
    
'sDate = InputBox("Please enter START date in this format: 'yyyy-mm-dd'")
'eDate = InputBox("Please enter END date in this format: 'yyyy-mm-dd'")
 sDate = Format(USGS.TextBox2.Text, "yyyy-mm-dd")
 eDate = Format(USGS.TextBox3.Text, "yyyy-mm-dd")
 
 
link = "https://waterdata.usgs.gov/ & _ 
StationID & sDate & eDate
 
 
 Unload USGS
 
Set IE = CreateObject("InternetExplorer.Application")
With IE
           .Visible = False
           .Navigate link 'URL
           
  Do Until .ReadyState = 4: DoEvents: Loop
  
           .ExecWB 17, 0 '// SelectAll
           .ExecWB 12, 2 '// Copy selection
End With
     

    iWsh.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
    Range("A1").Select
    
    IE.Quit
    Set IE = Nothing
    Set iWsh = Nothing
    
End Sub
Run Code Online (Sandbox Code Playgroud)

这是用户表单:我在使用 Input-Box 时没有遇到这个问题,所以我猜它与用户表单有关。这仅在用户关闭用户表单时发生。

Private Sub ToggleButton1_Click()
Me.Hide
    Cancel = True
End Sub

Private Sub OK_Click()
Me.Hide
End Sub
Run Code Online (Sandbox Code Playgroud)

注意:如果用户取消,它甚至不会打开IE并立即退出子。

但是如果用户关闭表单,它会打开 IE,并且不会将 设置Cancel为 True,这是退出子的条件。

更新: Expert-Exchange涵盖了该问题,但从未提出实际解决方案。

更新 2:关闭 IE 的所有实例不是一个选项。

这是现在设置用户表单的方式:

在此处输入图片说明

Dav*_*ens 1

好的,所以我无法复制该错误,因此您应该尝试以下两件事:

  1. 重新启动计算机并验证错误是否仍然存在。如果没有,问题就解决了。
  2. 在新的空白工作簿中重新创建用户窗体和代码,并查看错误是否仍然存在。如果没有,问题就解决了。

(有时工作簿和/或用户表单会损坏)

我还稍微重构了代码,即使上述建议之一解决了问题,您也可能会考虑。它只是稍微清理一下并使其更有目的。

在标准模块中,放置以下代码:

USGD过程显示用户窗体并卸载它。名为的单独过程GetData将在 IE 中完成工作并添加工作表等。GetData仅当用户单击表单上的“确定”按钮时才会执行该过程。因此,“X”/取消按钮将允许用户关闭表单。

Option Explicit

Sub USGD()
'Procedure displays the userform for the user
Dim USGSForm As New USGS
With USGSForm
    .StartUpPosition = 0
    .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
    .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
    .Show
End With
Unload USGSForm
End Sub

Sub GetData(StationID As String, sDate As String, eDate As String)
'This procedure queries the InternetExplorer for the values from UserForm
Dim iWsh As Worksheet
Dim link As String
Dim IE As Object

sDate = Format(sDate, "yyyy-mm-dd")
eDate = Format(eDate, "yyyy-mm-dd")

link = "https://waterdata.usgs.gov/nwis/dv?cb_00060=on&format=rdb&site_no=" & _
    StationID & "&referred_module=sw&period=&begin_date=" & sDate & "&end_date=" & eDate

Set IE = CreateObject("InternetExplorer.Application")
With IE
    .Visible = False
    .Navigate link 'URL
    Do Until .ReadyState = 4: DoEvents: Loop
    .ExecWB 17, 0 '// SelectAll
    .ExecWB 12, 2 '// Copy selection
    .Quit
End With

With ActiveWorkbook
    Set iWsh = .Sheets.Add(After:=.Sheets(.Sheets.Count))
End With
iWsh.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
Application.GoTo iWsh.Range("A1")

End Sub
Run Code Online (Sandbox Code Playgroud)

在您的 UserForm 模块中,放置以下代码:

这是“确定”按钮的代码,该按钮从表单上的文本框中获取值并将这些值发送到过程GetData。请注意,如果任何参数为空,Select Case该逻辑将提前退出该过程,因此它不会调用.GetData

Private Sub OK_Click()
    Dim id As String, sDate As String, eDate As String
    'Get values from the form
    id = Me.TextBox1.Value
    sDate = Me.TextBox2.Value
    eDate = Me.TextBox3.Value
    'Hide the form
    Me.Hide

    'If ANY required parameter is blank, this results in malformed URL so exit the procedure
    Select Case vbNullString
        Case id, sDate, eDate
            MsgBox "You left some parameter blank, no query will be performed.", vbInformation
            GoTo EarlyExit
        Case Else
            'Send values to the procedure that queries IE
            Call GetData(id, sDate, eDate)
    End Select

EarlyExit:
End Sub
Run Code Online (Sandbox Code Playgroud)