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

2019年7月28日 164次阅读

我有这个宏从网站中提取数据.我从用户那里得到了输入.它没有错误,但由于我无法看到的原因,IE将不会关闭并吸收我的所有RAM.是否需要其他东西而不是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

这是用户形式：我在使用Input-Box时没有遇到这个问题所以我猜测,现在我确信,它与用户表单有关.它只会在用户关闭用户表单时发生.

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

Private Sub OK_Click()
Me.Hide
End Sub

注意：如果用户取消,它甚至不会打开IE并在之后退出子.

但是它确实打开了IE,并且没有将Cancel设置为True,这是退出sub的条件.

更新：Expert-Exchange涵盖了该问题,但从未想出实际的解决方案.

Update-2：关闭IE的所有实例不是一种选择.

这就是用户表单的设置方式：

最佳答案 好的,所以我无法复制错误,所以你应该尝试两件事：

>重新启动计算机并验证错误是否继续.如果没有,问题就解决了.
>重新创建UserForm&代码在新的空白工作簿中,并查看错误是否继续.如果没有,问题就解决了.

(有时Workbook和/或UserForms已损坏)

我还重新考虑了一些代码,即使上述建议之一解决了问题,您也可以考虑使用.它只是清理了一点,使它更有目的性.

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

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

在UserForm模块中,放置以下代码：

这是“确定”按钮的代码,它从表单上获取TextBoxes的值并将它们发送到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
点赞