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实例,表单填充逻辑完全保留。
修改步骤:
- 在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
- 替换原代码中
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,仅需替换浏览器初始化部分,表单填充代码完全复用:
- 安装Selenium Basic,并下载对应浏览器的驱动(如EdgeDriver)。
- 替换原代码的浏览器实例获取逻辑:
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
相关产品推荐
相关产品推荐

