Excel VBA开发学生进度系统时预填链接过长无法提交数据至Google Sheets

问题原因 #

你当前的实现是将所有表单参数拼接在URL中通过GET请求提交，而GET请求的URL长度普遍存在2000字符左右的限制，你录入的字段数量多、评语类字段内容长度不确定，很容易超出限制导致提交失败。正确的解决方式是改用POST请求，将所有参数放在请求体中传输，不受URL长度限制。

另外你的原代码存在一处语法错误：URL_Last2 中拼接IslamicComment的位置少写了=号，会导致该字段参数格式错误。

修改后完整代码 #

' URL编码辅助函数，处理参数中的特殊字符
Function URLEncode(ByVal Text As String) As String
    Dim i As Integer
    Dim CharCode As Integer
    Dim Char As String
    For i = 1 To Len(Text)
        Char = Mid(Text, i, 1)
        CharCode = Asc(Char)
        Select Case CharCode
            Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95, 126
                URLEncode = URLEncode & Char
            Case 32
                URLEncode = URLEncode & "%20"
            Case Else
                URLEncode = URLEncode & "%" & Hex(CharCode)
        End Select
    Next i
End Function

Sub SendToGoogle()
    Dim FormSubmitURL As String
    Dim RequestBody As String
    Dim TicketInfo As MSXML2.ServerXMLHTTP60
    
    ' 仅保留表单提交基础地址，不需要拼接参数
    FormSubmitURL = "https://docs.google.com/forms/d/e/1FAIpQLScjgaoQH2OY8_g7ZbgAZV7EA7bm6Hd0_dZskW7eQgqzObZQBA/formResponse"
    
    ' 所有参数拼接为请求体，所有字段值都做URL编码处理
    RequestBody = "usp=pp_url" & _
        "&entry.1417086696=" & URLEncode(TeachersName) & _
        "&entry.1480907186=" & URLEncode(StudentName) & _
        "&entry.23393781=" & URLEncode(Age) & _
        "&entry.1787044956=" & URLEncode(DesignatedClass) & _
        "&entry.1336617490=" & URLEncode(MonthlyGoalsStatus) & _
        "&entry.855024799=" & URLEncode(MonthlyGoal) & _
        "&entry.1901482332=" & URLEncode(BMLevel) & _
        "&entry.283000664=" & URLEncode(EnglishLevel) & _
        "&entry.1518036587=" & URLEncode(MathLevel) & _
        "&entry.572588401=" & URLEncode(ScienceLevel) & _
        "&entry.362894336=" & URLEncode(IslamicLevel) & _
        "&entry.7094834=" & URLEncode(IndependentLevel) & _
        "&entry.1235784544=" & URLEncode(ArtLevel) & _
        "&entry.1146817666=" & URLEncode(JawiLevel) & _
        "&entry.941320954=" & URLEncode(IqraLevel) & _
        "&entry.2057356014=" & URLEncode(CambridgeLevel) & _
        "&entry.167021318=" & URLEncode(TechLevel) & _
        "&entry.537964950=" & URLEncode(LeaderLevel) & _
        "&entry.1173893187=" & URLEncode(PublicLevel) & _
        "&entry.771775066=" & URLEncode(RoboticLevel) & _
        "&entry.479434689=" & URLEncode(MathPLUSLevel) & _
        "&entry.892406885=" & URLEncode(BakingLevel) & _
        "&entry.1106219517=" & URLEncode(BrickLevel) & _
        "&entry.116139854=" & URLEncode(PhysicalLevel) & _
        "&entry.789971300=" & URLEncode(BMStatus) & _
        "&entry.198791007=" & URLEncode(EnglishStatus) & _
        "&entry.1991286245=" & URLEncode(MathStatus) & _
        "&entry.231856359=" & URLEncode(ScienceStatus) & _
        "&entry.1895003914=" & URLEncode(IslamicStatus) & _
        "&entry.997911219=" & URLEncode(IndependentStatus) & _
        "&entry.1195842579=" & URLEncode(ArtStatus) & _
        "&entry.135297141=" & URLEncode(JawiStatus) & _
        "&entry.65828675=" & URLEncode(IqraStatus) & _
        "&entry.489324965=" & URLEncode(CambridgeStatus) & _
        "&entry.725694321=" & URLEncode(TechStatus) & _
        "&entry.63116833=" & URLEncode(LeaderStatus) & _
        "&entry.1929148142=" & URLEncode(PublicStatus) & _
        "&entry.428565794=" & URLEncode(RoboticStatus) & _
        "&entry.1931195002=" & URLEncode(MathPLUSStatus) & _
        "&entry.389281264=" & URLEncode(BakingStatus) & _
        "&entry.264953265=" & URLEncode(BrickStatus) & _
        "&entry.402102536=" & URLEncode(PhysicalStatus) & _
        "&entry.902060269=" & URLEncode(BMComment) & _
        "&entry.130882209=" & URLEncode(EnglishComment) & _
        "&entry.2104221501=" & URLEncode(MathComment) & _
        "&entry.1584171548=" & URLEncode(ScienceComment) & _
        "&entry.308169846=" & URLEncode(IslamicComment) & _ ' 修复原代码缺失的=号
        "&entry.1778216349=" & URLEncode(IndependentComment) & _
        "&entry.1888240101=" & URLEncode(ArtComment) & _
        "&entry.746401376=" & URLEncode(JawiComment) & _
        "&entry.1750886136=" & URLEncode(IqraComment) & _
        "&entry.736281504=" & URLEncode(CambridgeComment) & _
        "&entry.716508565=" & URLEncode(TechComment) & _
        "&entry.1192188084=" & URLEncode(LeaderComment) & _
        "&entry.1828566042=" & URLEncode(PublicComment) & _
        "&entry.653415414=" & URLEncode(RoboticComment) & _
        "&entry.943404131=" & URLEncode(MathPLUSComment) & _
        "&entry.500469194=" & URLEncode(BakingComment) & _
        "&entry.524429676=" & URLEncode(BrickComment) & _
        "&entry.2006146722=" & URLEncode(PhysicalComment) & _
        "&entry.1195839299=" & URLEncode(BMOtherComment) & _
        "&entry.572497393=" & URLEncode(EnglishOtherComment) & _
        "&entry.1779781765=" & URLEncode(MathOtherComment) & _
        "&entry.1443549238=" & URLEncode(ScienceOtherComment) & _
        "&entry.91600726=" & URLEncode(IslamicOtherComment) & _
        "&entry.600022209=" & URLEncode(IndependentOtherComment) & _
        "&entry.499331422=" & URLEncode(ArtOtherComment) & _
        "&entry.699366184=" & URLEncode(JawiOtherComment) & _
        "&entry.687267933=" & URLEncode(IqraOtherComment) & _
        "&entry.494442256=" & URLEncode(CambridgeOtherComment) & _
        "&entry.270986380=" & URLEncode(TechOtherComment) & _
        "&entry.70939666=" & URLEncode(LeaderOtherComment) & _
        "&entry.1906540560=" & URLEncode(PublicOtherComment) & _
        "&entry.1287355695=" & URLEncode(RoboticOtherComment) & _
        "&entry.393486256=" & URLEncode(MathPLUSOtherComment) & _
        "&entry.1679577233=" & URLEncode(BakingOtherComment) & _
        "&entry.1304233785=" & URLEncode(BrickOtherComment) & _
        "&entry.730291442=" & URLEncode(PhysicalOtherComment) & _
        "&submit=Submit"
    
    ' 发送POST请求
    Set TicketInfo = New MSXML2.ServerXMLHTTP60
    With TicketInfo
        .Open "POST", FormSubmitURL, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
        .send RequestBody
        ' 可通过下面的代码判断提交结果，不需要可以删除
        If .Status = 200 Then
            MsgBox "数据提交成功"
        Else
            MsgBox "提交失败，错误码：" & .Status
        End If
    End With
    Set TicketInfo = Nothing
End Sub

注意事项 #

• 使用前需要确保VBA引用中已经勾选了Microsoft XML, v6.0（在VBA编辑器的工具->引用中设置）
• 参数全部做了URL编码处理，避免字段值中的特殊字符（比如&、空格、中文）破坏参数格式

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