Excel VBA自动提交Google Form返回Access Denied错误如何解决

根因说明 #

你遇到的Access Denied报错、无报错但表单未收到数据的问题，确实是Google Form服务端反爬规则更新导致的。近年Google针对非浏览器发起的直接POST请求新增了多维度校验：

• 你代码中硬编码的dlut、fbzx、draftResponse均为单次会话有效的动态参数，过期后即使格式正确也会被服务端静默拒绝
• 缺少合法的User-Agent请求头、有效会话Cookie，会触发跨域、权限拒绝类报错

可行修复方案 #

方案1：新增动态参数拉取逻辑（最稳定） #

先发起GET请求拉取表单页面获取实时动态参数、会话Cookie，再发起提交请求，修正后代码如下：

Sub postGoogleDataFixed()
    ' 需提前引用Microsoft XML v6.0
    Dim http As New MSXML2.XMLHTTP60
    Dim getUrl As String, postUrl As String, params As String
    Dim respText As String, fbzx As String, draftResp As String, dlut As String
    
    ' 第一步：GET请求获取实时动态参数和Cookie
    getUrl = "https://docs.google.com/forms/d/e/1FAIpQLSejadFloQF5V69ZZ1fc1kManOZ_vMw8kq10-56ENroZ4c6xiw/viewform"
    http.Open "GET", getUrl, False
    http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36"
    http.send
    respText = http.responseText
    
    ' 提取页面中的动态参数，可替换为正则匹配提升稳定性
    fbzx = Split(Split(respText, "fbzx=")(1), "&")(0)
    draftResp = "%5Bnull%2Cnull%2C%22" & fbzx & "%22%5D"
    dlut = Split(Split(respText, "dlut=")(1), "&")(0)
    
    ' 拼接提交参数，注意空格替换为+号做url编码
    params = "entry.1880992192=" & Replace(Range("A1").Value, " ", "+") & _
             "&entry.2125520249=" & Replace(Range("A2").Value, " ", "+") & _
             "&entry.1421191722=" & Replace(Range("A3").Value, " ", "+") & _
             "&entry.1858469755=Option+1&entry.1858469755=Option+2&dlut=" & dlut & _
             "&entry.1858469755_sentinel=&fvv=1&draftResponse=" & draftResp & _
             "&pageHistory=0&fbzx=" & fbzx
    
    ' 第二步：携带Cookie和完整请求头发起POST提交
    postUrl = "https://docs.google.com/forms/u/0/d/e/1FAIpQLSejadFloQF5V69ZZ1fc1kManOZ_vMw8kq10-56ENroZ4c6xiw/formResponse"
    http.Open "POST", postUrl, False
    http.setRequestHeader "content-type", "application/x-www-form-urlencoded"
    http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36"
    http.send params
    
    ' 可通过http.Status判断提交结果，200即为请求成功
    Debug.Print "提交请求状态码：" & http.Status
End Sub

方案2：适配ServerXMLHTTP兼容严格网络环境 #

如果使用XMLHTTP60依旧被拦截，可以替换为MSXML2.ServerXMLHTTP60，添加忽略SSL校验的配置即可：

' 将http对象声明替换为以下内容
Dim http As New MSXML2.ServerXMLHTTP60
http.SetOption 2, 13056 ' 忽略所有SSL证书相关错误

方案3：降低表单校验等级（仅适用于你是表单所有者的场景） #

进入表单设置页面，关闭需要登录才能提交、限制每个用户提交1次两个选项，即可降低Google的反爬校验等级，提升提交成功率。

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