VBA高阶系列3: "原生"调用JavaScript脚本

一. 前言

对于爬虫有过较为深入了解的用户, 应该多少和JavaScript到过交道, 在爬虫的逆向很多时候都需要将目标页面的 js 文件存取到本地, 修改使之能够用于破解页面反爬. 通常这种脚本较为繁琐, 改成目标语言, 如python, 是相当麻烦, 虽然现在有ai的辅助, 可以将一些简单的js脚本转换为指定的语言, 但考虑到转换后的各种问题, 直接运行原脚本获取到需要的信息更为可靠和直接.

二. AI提供的解决方案

测试了文心一言, 豆包, deepseek, 通义千问, chatgpt(不知道哪个版本), 前四者均开启深度思考模式.

除了通义之外, 其他的几家给出的答案均相对雷同.

各种方案的差异无外乎:

兼容性
性能
使用的简便性
结果能否返回

2.1 基于脚本控件

这种方式是检索中出现最高频率的, 但是兼容性不好.

Sub UseScriptControl()
    Dim sc As Object
    Set sc = CreateObject(" MSScriptControl.ScriptControl.1")

    ' 设置脚本语言为 JScript
    sc.Language = "JScript"

    ' 添加 JavaScript 代码( 可包含函数, 变量)
    sc.AddCode "function add(a, b) { return a + b; }"

    ' 调用函数并获取返回值
    Dim result As Variant
    result = sc.Run("add", 3, 5) ' 调用 add(3, 5)
    MsgBox result ' 输出 8
End Sub

在x64 OFFICE中使用ScriptControl控件的方法_function createwindow() dim ssignature, oshellwnd,-CSDN博客

2.2 基于IE浏览器

Sub UseIEControl()
    Dim ie As Object
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = False ' 可选: 显示浏览器窗口

    ' 加载包含 JS 函数的网页( 可本地或远程)
    ie.Navigate "about:blank"
    Do While ie.ReadyState <> 4: DoEvents: Loop ' 等待加载完成

    ' 向网页写入 HTML 并嵌入 JS 代码
    ie.Document.body.innerHTML = "<script>function sayHello() { return 'Hello from JS!';</script>"

    ' 调用网页中的 JS 函数
    Dim result As Variant
    result = ie.Document.parentWindow.execScript("sayHello()", "JScript")
    MsgBox result ' 输出 "Hello from JS!"

    ie.Quit
End Sub

deepseek还给出了基于Selenium的解决方案

' 需安装Selenium Basic并引用库
Sub ExecuteJavaScriptWithSelenium()
    Dim driver As New WebDriver
    driver.Start "chrome", ""
    driver.Get "about:blank"

    ' 执行JS并获取结果
    Dim jsResult As Variant
    jsResult = driver.ExecuteScript("return 2 + 3 * 5;")
    MsgBox "计算结果: " & jsResult

    driver.Quit
End Sub

2.3 基于WSH

这种方式算是较好的了, 但是结果返回结果类型只能是字符串.

Sub UseWSH()
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")

    ' 定义 JS 脚本内容( 保存为临时文件)
    Dim jsCode As String
    jsCode = "function add(a, b) { WScript.Echo(a + b); }" & vbNewLine
    jsCode = jsCode & "add(3, 5);"

    ' 保存临时 JS 文件
    Dim tempPath As String
    tempPath = Environ("Temp") & "\temp.js"
    Open tempPath For Output As #1
    Print #1, jsCode
    Close #1

    ' 执行 JS 脚本并获取输出
    Dim output As String
    output = wsh.Run("cscript //nologo " & tempPath, 0, True)
    MsgBox output ' 输出 8( 通过 WScript.Echo 返回)
End Sub

2.4 基于NodeJS

这里读取结果有问题, 同时依赖nodejs.

Sub UseNodeJS()
    Dim nodePath As String
    nodePath = "C:\Program Files\nodejs\node.exe" ' Node 可执行文件路径
    Dim jsFile As String
    jsFile = "D:\Desktop\new 4.js" ' JS 脚本路径

    ' 执行 Node 脚本并获取输出
    Dim result As String
    result = CreateObject("WScript.Shell").Exec(nodePath & " " & jsFile).StdOut.ReadAll
    MsgBox result
End Sub

2.5 基于htmlfile对象

这是最好的实现方法, 也是我所预期的, 但是除了通义千问之外, 都没给出这个答案.

Sub RunJSIn64BitExcel()
    Dim htmlDoc As Object
    Set htmlDoc = CreateObject("htmlfile")

    ' 注入 JS 代码
    htmlDoc.parentWindow.execScript "function add(a, b) { return a + b; }", "JavaScript"

    ' 执行并获取结果
    Dim result
    result = htmlDoc.parentWindow.add(10, 20)
    MsgBox "Result: " & result
End Sub

下面内容的核心将以此展开.

window.execScript与eval的介绍-CSDN博客

2.6 小结

方法	适用场景	优点	缺点
Internet Explorer	与网页交互	直接操作网页元素	依赖 IE, 安全性限制
ScriptControl	直接运行 JS 代码	简单快捷	不支持 64 位 Excel
Node.js	复杂脚本或服务器端 JS	强大功能	需安装 Node.js
WebBrowser 控件	嵌入式 Web 内容交互	集成方便	功能有限
本地 HTML 文件	需要临时文件存储 JS	灵活可控	需管理文件路径
HTMLDocument 对象	64 位 Excel 兼容性	兼容性好	需熟悉 HTML 对象模型

三. 最终方案

首先需要了解这段代码起到什么作用.

Set html = CreateObject("htmlfile")

这里实际上和启动ie浏览器类似, 目的在于获取一个document对象.

parentWindow, 顾名思义获取父窗口(window), 即全局对象.

Sub test()

    Dim html As Object
    Set html = CreateObject("htmlfile")

    html.body.innerhtml = "<div class=" & """test""" & "><div>test</div></div>"

    Dim x As Object

    Set x = html.getElementsByClassName("test") ' 需要注意, `getElementsByClassName`这个方法在`ie9`之前都不支持.'

    Debug.Print 1
End Sub

得到document对象后, 即可以像在浏览器中操作dom类似了, 同理也可以操作其他的js对象.

但是需要注意的是:

VBA是需要声明变量类型的(当然有variant这种通用型变量类型)
JavaScript是需要声明变量但是不需要声明类型, 而且js是弱类型的语言, 即不同类型的数据之间相互发生关系是不会报错

如:
```
var s = 1;
s + '1' // 这里是不报错
```
不仅不报错, js还具备隐式转换的操作, 即不同类型数据之间的交互产生的结果会很诡异.

在js中, 万物皆对象(object)

'abc'.includes('a');
true
1.23.toFixed(1);
'1.2'

3.1 注册表

默认状态下, office调用的ie版本为 8, 这个版本过于老旧, 对于各种js语法的支持都很差, 所以需要强制调用最新的ie, 理论上就是ie11.

需要修改一下注册表:

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION]
"excel.exe"=dword:00011000

office: x64, os: x64
office: x86, os: x86

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION]
"excel.exe"=dword:00011000

office: x86, os: x64

将上述内容复制保存.reg格式文件, 关闭excel, 导入注册表重新启动即可.

3.2 处理JSON

这也是最有价值的部分, json作为各类计算机语言交互最主要的数据载体, 但是vba却没有原生支持, 这意味着假如使用vba处理数据时将受到严重制约.

尽管有国外大神写的相关处理json库, GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA, 但是这个库不支持中文.

这里使用B站的首页推荐的api数据作为测试, api_json

Function rt()
    Dim filePath As String
    Dim stream As Object

    filePath = "C:\Users\Lian_\Desktop\json.json"

    ' 创建Stream对象
    Set stream = CreateObject("ADODB.Stream")
    stream.Charset = "UTF-8" ' 根据文件编码调整( 如GBK, ANSI等)
    stream.Open
    stream.LoadFromFile filePath
    rt = stream.ReadText
    stream.Close
End Function

Sub JsonStringToObject()
    Dim html As Object
    Dim jsonStr As String
    Dim jsonObj As Object

    ' 创建HTML文件对象
    Set html = CreateObject("htmlfile")

    ' JSON字符串, 包裹在单引号中, 而不是``模板字符串
    jsonStr = "JSON.parse('" & rt() "');"

    ' 解析JSON字符串
    Set jsonObj = html.parentwindow.eval(jsonStr)
End Sub

注意, 模板字符串, IE不支持, 所以内容不允许存在换行符.

3.3 操作各种`js`对象

在CreateObject("htmlfile")下, vba 的数字和字符串和js不做区分, 不需要做任何的转换.

这里主要看这3种对象:

数组
对象(字典, js 中没有字典这个概念, 使用object来类似实现功能)
函数

html.parentwindow.eval(js)

这段代码的返回结果, 取决于执行js代码后最终输出的内容.

Sub JsonStringToObject()
    Dim html As Object
    Dim arr As Object, dic As Object, func As Object

    ' 创建HTML文件对象
    Set html = CreateObject("htmlfile")

    ' 数组
    Set arr = html.parentwindow.eval("[1,2,3]")

    arr.push (4)
    ' arr[0]

    Debug.Print arr

    ' 函数
    Set func = html.parentwindow.eval("function test(a, b) { return a + b; } test")

    Debug.Print func(1, 3)

    Dim s As String
    ' 字符串
    s = html.parentwindow.eval("var s = 'abc'; s;")
    'Debug.Print s.indexOf(0)

    ' 解析JSON字符串
    Set dic = html.parentwindow.eval("var dic = {test: 1}; dic;")

    Debug.Print dic.test
    ' dic.test = 2
End Sub

3.4 操作数组

从上述的操作, 是否觉得好像在vba可以无缝操作JavaScript.

答案是否, 这里以操作数组来演示相关问题.

Set arr = html.parentwindow.eval("[1,2,3]")

arr.push (4)
' arr[0] // 读取数据出错, 自定义的函数也无法调用

[], ()两种方式均无法从数组中读取到值.

var my_arr = [1,2,3]; my_arr.get_value =  function() {return this[0];}

像这种自定义函数, 在vba中也无法直接调用, 还有各种问题在这里就不一一赘述, 总之无法像正常操作js

这是什么原因导致的呢?

Sub test2()
    Dim h As Object

    Set h = CreateObject("htmlfile")

    Dim js As String
    js = "var my_arr = [1,2,3]; my_arr.get_value =  function(index) {return this[0];}" & Chr(10) & "my_arr;"
    Set o = h.parentwindow.eval(js)
    Debug.Print o.get_value()
    Debug.Print o.get_value(0)
End Sub

为什么相同的函数, 实际上上述传递的参数在js函数不起作用, 但是为什么传递参数了, 可以正确返回数据, 不传递参数直接返回了函数代码呢?

显然, 这就是vba的那残破的语法导致的.

Function t()
    Debug.Print 1
    t = 1
End Function

Sub main()

    Dim i As Long
    t     ' 也能执行
    i = t ' 执行函数也能返回值
    Debug.Print t() '执行函数, 同时返回值, 返回值就必须输出或者是有变量接受这个值
End Sub

假如从上文你可能还没感受到vba语法的智障, 当看了数组时, 你就会被这种智障给吓呆了.

在一堆辣鸡代码中, 请问如何有效区分数组和函数(function), 和sub之间的差异.

Sub m()
    Dim arr(0) As Long
    arr(0) = 1

    Debug.Print arr(0)
    ' Debug.Print t(0)
End Sub

1993年发布的Excel 5中, 微软开始推广VBA作为宏语言, 并同时引进VBA编辑器, 即VBE( Visual Basic Edirtor) . 用户可以通过录制宏来产生代码, 代码储存在VBE环境的代码模块中, 利用Alt+F8可以反复调用录制的宏.

2.1 VBA的发展史与优缺点_Excel VBA程序开发自学宝典最新章节在线阅读-创世中文网官网

作为一个并不算发布时间特别"早"的语言, vba的这种语法设计和今天的咖喱味window(bug 11/10)可谓相得益彰, 可谓活活着活回去了.

3.5 小结

综上, 来看看如何"正确"地调用对象函数.

Sub test2()
    Dim h As Object

    Set h = CreateObject("htmlfile")

    Dim js As String
    js = "[1,2,3]"
    Set o = h.parentwindow.eval(js)
    Debug.Print o.pop(1)
    Debug.Print o
End Sub

当需要调用对象的函数时, 需要随意输入参数, 即可正常调用

Sub test3()
    Dim h As Object

    Set h = CreateObject("htmlfile")

    Dim js As String
    js = "Date.now()"
    Debug.Print h.parentwindow.eval(js) ' 在使用js时不使用函数包裹'
End

sub test4()
    Dim h As Object

    Set h = CreateObject("htmlfile")

    Dim js As String
js = "function timestamp(){return Date.now();} timestamp();" ' 如需要函数调用, 在js中执行这个函数'
    Debug.Print h.parentwindow.eval(js)
End Sub

Sub test5()
    Dim h As Object

    Set h = CreateObject("htmlfile")

    Dim js As String
	js = "function timestamp(){return Date.now();} timestamp;" ' 当返回的对象是函数'
    Dim o As Object
    Set o = h.parentwindow.eval(js)
	Debug.Print o(0) '随意输入参数即可正常调用'
End Sub

对于无法直接访问或者设置的对象属性, 可以使用一个函数间接实现.

Sub test3()
    Dim h As Object

    Set h = CreateObject("htmlfile")

    Dim js As String
    js = "var dic = { a: 1 , set_value: function(key, val) { this[key] = val; } };" & Chr(10) & " dic;"
    Dim o As Object
    Set o = h.parentwindow.eval(js)
    Debug.Print o.a
    o.set_value "a", 2
    Debug.Print o.a
End Sub

至此, "原生"调用js基本实现.

四. 二维码生成问题

某制造飞行汽车公司发给供应商的零配件二维码要求.

这在excel中不算什么困难问题, 原生控件可以实现, 但假如需要实现更多细节, 就无法实现了.

Sub genBarCode()
    '清除已有二维码
    Call clearBarCode
    With ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1")
        .Object.Style = 11    '二维码样式
        .Object.Value = Range("B1").Value    '二维码内容
        '二维码大小和单元格A1相同
        .Height = Cells(1, 1).Height
        .Width = Cells(1, 1).Width
        .Left = Cells(1, 1).Left
        .Top = Cells(1, 1).Top
    End With
End Sub

Sub clearBarCode()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = 12 Then shp.Delete
    Next
End Sub

这里不使用自带控件实现, 而是调用外部的js脚本来实现.

4.1 前端二维码开源项目

让豆包生成前端都有哪些开源的二维码库:

场景	推荐库	理由
快速集成	QRCode.js	轻量, 零依赖, 支持跨浏览器
精细参数控制	qrcode-generator	支持纠错级别, 颜色, 尺寸等深度定制
艺术化设计	QRious	支持渐变色, 背景图, 生成视觉独特的二维码
响应式 / 印刷需求	qrcode-svg	生成 SVG 矢量图, 缩放不失真
Vue 项目	vue-qrcode-component	与 Vue 框架无缝集成, 支持动态更新
扫码功能	ZXing JS Library	同时支持生成和解码, 适合扫码登录等场景
动态海报生成	QRCanvas	支持添加背景图, Logo, 提供可视化工具
老旧 jQuery 项目	jquery-qrcode	依赖 jQuery, 适合快速迁移

简单看了一下各个库的文档, 挑选出api调用简单, 兼容ie, 调用不涉及异步, 最后选定: neocotic/qrious: Pure JavaScript library for QR code generation using canvas这个库用于测试可行性.

4.2 处理

cdn.bootcdn.net/ajax/libs/qrious/4.0.2/qrious.min.js

首先从这个cdn中获得这个脚本文件, 由于需要直接运行脚本, 观察可以发现脚本外层包裹这这样一个函数

!function(t,e){"object"==typeof exports&&"undefined"!=typeof module?module.exports=e():"function"==typeof define&&define.amd?define(e):t.QRious=e()}(this,function(){})

这样处理一下方便观察.

!function(t, e) {
    // 检查是否为 CommonJS 模块环境
    if ("object" === typeof exports && "undefined"!== typeof module) {
        module.exports = e();
    }
    // 检查是否为 AMD 模块环境
    else if ("function" === typeof define && define.amd) {
        define(e);
    }
    // 如果不是上述两种环境, 则将其作为全局变量挂载
    else {
        t.QRious = e();
    }
}(this, function() {});

实际上就是检测运行的环境, 这部分内容显然不是这里直接运行脚本所需的, 去掉即可.

// t.QRious=e()

var QRious = function () {} // 将这部分内容拿出来

// 当然这里可以拿出来作为一个函数, 而不是写在js文件中, 这里仅作为测试
var qr = new QRious({value: 'text'});
qr.toDataURL('image/jpeg');

将修改的文件保存起来即可.

ie10/11均已支持JavaScript的严格模式.

Function rt()
    Dim filePath As String
    Dim stream As Object

    filePath = "D:\Desktop\codeqr.js"

    ' 创建Stream对象
    Set stream = CreateObject("ADODB.Stream")
    stream.Charset = "UTF-8" ' 根据文件编码调整( 如GBK, ANSI等)
    stream.Open
    stream.LoadFromFile filePath
    rt = stream.ReadText
    stream.Close
End Function

Sub test1()
 Dim html As Object
    Dim jsonStr As String
    Dim jsonObj As Object

    ' 创建HTML文件对象
    Set html = CreateObject("htmlfile")
    Debug.Print html.parentwindow.eval(rt())
End Sub

当拿到图片的base64的数据, 即完成预期目标

转换为图片, 参见我的另一代码: VBA/module/c_imgFile_base64_convertor.cls at main - Kyouichirou/VBA

五. 总结

将需要实现的功能直接封装在js代码中, 如可以甩掉vba难用的数组使用js数组.

当然并不意味着相关功能不能使用vba实现, 主要是太麻烦.

' JSAarray 类模块代码
Option Explicit

Private arr As Collection

Private Sub Class_Initialize()
    Set arr = New Collection
End Sub

' 添加元素到数组末尾
Public Sub push(item As Variant)
    arr.Add item
End Sub

' 从数组末尾移除元素并返回
Public Function pop() As Variant
    If arr.Count > 0 Then
        pop = arr(arr.Count)
        arr.Remove arr.Count
    Else
        pop = Null
    End If
End Function

' 获取数组长度
Public Property Get length() As Long
    length = arr.Count
End Property

' 通过索引访问元素( 注意: VBA集合索引从1开始, 这里调整为从0开始)
Public Property Get item(index As Long) As Variant
    If index >= 0 And index < arr.Count Then
        item = arr(index + 1)
    Else
        item = Null
    End If
End Property

' 设置元素值
Public Property Let item(index As Long, value As Variant)
    If index >= 0 And index < arr.Count Then
        arr.Add value, , , index + 1
    Else
        ' 如果索引超出范围, 可以选择扩展数组或报错
        ' 这里简单处理为不做操作
    End If
End Property

' 将数组转换为字符串表示
Public Function toString() As String
    Dim result As String
    Dim i As Long

    result = "["
    For i = 1 To arr.Count
        result = result & arr(i)
        If i < arr.Count Then
            result = result & ", "
        End If
    Next i
    result = result & "]"

    toString = result
End Function

使用vba模拟js的数组.

不建议使用vba解决过于复杂的问题, 如需要几千行代码的, 假如使用vba来实现, 其工程量是巨大的.