You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

IE停用后,如何修改现有Excel VBA代码填充网页表单?

问题背景

我有一套Excel VBA代码,依赖Microsoft HTML Object Library、Microsoft Internet Controls组件和IE浏览器,用来给州立网站的医院数据表单填数据。每次处理一家医院,但单份表单数据量很大(示例为第12页待录入数据)。

之前的操作流程是:提前打开IE,登录州立网站并激活目标表单页面。

以下是对应第12页数据的子程序开头代码:

Sub TWELVE_Internet_form_fill_Part1()
Dim ieDoc As Object
Dim sws As SHDocVw.ShellWindows
Dim strURL As String
Dim n As Integer
'Set main URL to evaluate open IE windows
strURL = "https://siera.oshpd.ca.gov/"
Set sws = New SHDocVw.ShellWindows
'Cycle through all open IE windows and assign the window whose URL matches strURL
For n = 0 To sws.Count - 1
If Left(sws.Item(n).LocationURL, Len(strURL)) = strURL Then
Set ieDoc = sws.Item(n).document
sws.Item(n).Visible = True
Exit For
End If
Next n

'Medicare Traditional Inpatient Daily Hospital Services

ieDoc.all.txtPCL1_5.Value = ThisWorkbook.Sheets("12 Final").Range("B9")
ieDoc.all.txtPCL1_10.Value = ThisWorkbook.Sheets("12 Final").Range("B10")
ieDoc.all.txtPCL1_15.Value = ThisWorkbook.Sheets("12 Final").Range("B11")
ieDoc.all.txtPCL1_20.Value = ThisWorkbook.Sheets("12 Final").Range("B12")
ieDoc.all.txtPCL1_25.Value = ThisWorkbook.Sheets("12 Final").Range("B13")
ieDoc.all.txtPCL1_30.Value = ThisWorkbook.Sheets("12 Final").Range("B14")
ieDoc.all.txtPCL1_35.Value = ThisWorkbook.Sheets("12 Final").Range("B15")
ieDoc.all.txtPCL1_40.Value = ThisWorkbook.Sheets("12 Final").Range("B16")
ieDoc.all.txtPCL1_45.Value = ThisWorkbook.Sheets("12 Final").Range("B17")
ieDoc.all.txtPCL1_50.Value = ThisWorkbook.Sheets("12 Final").Range("B18")

补充:试过Edge的IE兼容模式,但代码无法运行。

求最小改动现有VBA代码的解决方案。


解决方案

方案1:适配Edge IE兼容模式(最小代码改动)

Edge的IE兼容模式窗口不会被SHDocVw.ShellWindows识别,需要通过Windows API枚举窗口获取对应的IE实例,表单填充逻辑完全保留。

修改步骤:

  1. 在VBA模块顶部添加API声明:
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" (ByVal lpsz As String, ByRef lpiid As GUID) As Long
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As LongPtr, ByVal dwId As Long, ByRef riid As GUID, ByRef ppvObject As Object) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
  1. 替换原代码中ShellWindows枚举窗口的部分,改用以下代码获取IE模式的文档对象:
' 替换原有的sws枚举逻辑
Dim hWnd As LongPtr
Dim ieObj As Object
Dim IID_IWebBrowserApp As GUID
Dim IID_IDispatch As GUID

' 定义接口ID
IIDFromString "{0002DF05-0000-0000-C000-000000000046}", IID_IWebBrowserApp
IIDFromString "{00020400-0000-0000-C000-000000000046}", IID_IDispatch

' 查找Edge IE模式窗口
hWnd = FindWindowEx(0&, 0&, "IEFrame", vbNullString)
Do While hWnd <> 0
    If AccessibleObjectFromWindow(hWnd, &HFFFFFFF0, IID_IWebBrowserApp, ieObj) = 0 Then
        If Left(ieObj.LocationURL, Len(strURL)) = strURL Then
            Set ieDoc = ieObj.document
            ieObj.Visible = True
            Exit Do
        End If
    End If
    hWnd = FindWindowEx(0&, hWnd, "IEFrame", vbNullString)
Loop

方案2:继续使用独立IE11浏览器

如果系统支持,可启用保留的IE11组件,继续使用原有代码:

  • 打开控制面板>程序>启用或关闭Windows功能,勾选Internet Explorer 11并重启系统。
  • 确认VBA编辑器中已勾选Microsoft Internet Controls(SHDocVw)和Microsoft HTML Object Library(工具>引用)。

方案3:改用Selenium Basic(兼容现代浏览器)

若IE彻底无法使用,可改用Selenium Basic控制Edge/Chrome,仅需替换浏览器初始化部分,表单填充代码完全复用:

  1. 安装Selenium Basic,并下载对应浏览器的驱动(如EdgeDriver)。
  2. 替换原代码的浏览器实例获取逻辑:
Dim driver As New EdgeDriver
driver.Get "https://siera.oshpd.ca.gov/"
' 如需自动登录,在此添加登录操作代码
Set ieDoc = driver.ExecuteScript("return document;")

后续的ieDoc.all.xxx.Value赋值代码无需修改。


内容的提问来源于stack exchange,提问作者William Viergever

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.02 12:05:45