修改VBA宏以复用单个Internet Explorer窗口的技术请求

Got it, let's fix that tedious IE window spawning issue you're dealing with. Instead of creating and closing 48 separate IE instances, we can reuse a single window across all formula calls to drastically boost efficiency. Here's the revised code with key improvements explained:

Option Explicit
' Module-level variable to keep the IE instance alive between UDF calls
Private IE As InternetExplorer

Public Function ConvertUSD(ConvertWhat As String) As Double
    ' Required References:
    ' - Microsoft XML, v6.0
    ' - Microsoft Internet Controls
    ' - Microsoft HTML Object Library
    Dim targetDomain As String
    targetDomain = "oanda.com" ' Update this if your target currency site changes
    
    ' Check if we have a usable existing IE instance
    If IE Is Nothing Or IE.ReadyState = READYSTATE_UNINITIALIZED Or IE.Busy Then
        ' First try to find an open IE window pointing to our target domain
        Set IE = GetExistingIEWindow(targetDomain)
        
        ' If no matching window exists, create a new hidden instance
        If IE Is Nothing Then
            Set IE = New InternetExplorer
            IE.Visible = False ' Hidden mode speeds up loading significantly
        End If
    End If
    
    ' Navigate to the currency converter with the input currency code
    IE.Navigate "https://www.oanda.com/currency/converter?quote_currency=USD&base_currency=" & ConvertWhat
    
    ' Wait for the page to fully load (avoid race conditions)
    Do
        DoEvents
    Loop Until IE.ReadyState = READYSTATE_COMPLETE And Not IE.Busy
    
    ' Extract the exchange rate from the page
    Dim Doc As HTMLDocument
    Dim Ans As String
    Dim AnsExtract As Variant
    
    On Error Resume Next ' Handle cases where page structure changes unexpectedly
    Set Doc = IE.Document
    Ans = Trim(Doc.getElementsByTagName("tbody")(2).innerText)
    AnsExtract = Split(Ans, " ")
    
    ' Return valid rate if extraction worked, else handle error
    If UBound(AnsExtract) >= 4 Then
        ConvertUSD = CDbl(AnsExtract(4))
    Else
        ConvertUSD = CVErr(xlErrNA) ' Return #N/A in Excel if extraction fails
    End If
    On Error GoTo 0
End Function

' Helper function to scan for existing IE windows matching our target domain
Private Function GetExistingIEWindow(targetDomain As String) As InternetExplorer
    Dim shellWindows As New ShellWindows
    Dim win As Object
    Dim currentURL As String
    
    For Each win In shellWindows
        ' Check if the window is an IE instance
        If TypeName(win) = "InternetExplorer" Then
            currentURL = LCase(win.LocationURL)
            ' Match the domain (handles subdomains like www.oanda.com)
            If InStr(currentURL, LCase(targetDomain)) > 0 Then
                Set GetExistingIEWindow = win
                Exit Function
            End If
        End If
    Next win
    
    ' No matching window found
    Set GetExistingIEWindow = Nothing
End Function

Key Improvements & Usage Notes: #

• Persistent IE Instance: The module-level IE variable keeps the window alive between formula calls, eliminating the overhead of opening/closing windows 48 times.
• Reuse Existing Windows: The GetExistingIEWindow helper scans open IE windows to find one already pointing to your target site—no need to create a new window if one exists.
• Error Resilience: Added basic error handling to deal with unexpected page structure changes (returns #N/A in Excel if extraction fails, which is more user-friendly than a hard crash).
• Domain Flexibility: Update the targetDomain variable if you ever switch to a different currency website.
• Performance: Running IE in hidden mode cuts down on loading time compared to visible windows.

How to Use: #

Just like before, enter =ConvertUSD(A1) in cell B1, then drag the formula down to row 48. The IE window will be reused for all calls, making the process far faster and less intrusive.

内容的提问来源于stack exchange，提问作者urdearboy