Excel VBA调用Pushbullet发送短信多行换行失效及状态通知求助

问题原因 #

单行消息正常、多行失效的核心原因是JSON格式非法：你直接把多行文本框的内容拼到JSON里，文本自带的换行符（vbCrLf）、双引号等特殊字符没有做JSON转义，导致服务端无法解析请求体。

解决方案 #

第一步：新增JSON转义公用函数 #

先在你的代码模块中添加以下公用函数，用来处理特殊字符转义：

' 公用函数：处理JSON字符串转义
Function JsonEscape(rawStr As String) As String
    Dim escapedStr As String
    escapedStr = Replace(rawStr, "\", "\\")
    escapedStr = Replace(escapedStr, """", "\""")
    escapedStr = Replace(escapedStr, vbCrLf, "\n") ' 处理Windows换行
    escapedStr = Replace(escapedStr, vbLf, "\n") ' 处理Unix换行
    escapedStr = Replace(escapedStr, vbCr, "\n") ' 处理旧Mac换行
    escapedStr = Replace(escapedStr, vbTab, "\t") ' 处理制表符
    JsonEscape = escapedStr
End Function

第二步：替换原有点击事件代码 #

用以下代码替换你原来的smsfac_Click逻辑，同时已内置发送状态通知功能：

Private Sub smsfac_Click()
    Dim lastrow As Integer
    ' 空值校验逻辑保持不变
    If Me.sms_client.Value = "" Or Me.sms_nmbr.Value = "" Or Me.sms_txt.Value = "" Then
        Me.smsfac.ForeColor = vbRed
        Me.smsfac.BorderColor = vbRed
        Application.Wait (Now + TimeValue("0:00:3"))
        Me.smsfac.ForeColor = &HFFFF00
        Me.smsfac.BorderColor = &H80000006
    Else
        Dim item As ListItem
        Dim ACCESS_TOKEN As String
        Dim TARGET_DEVICE_IDEN As String
        Dim receiver_number As String, text_message As String
        Dim Request As Object, URL As String, postData As String
        Dim respText As String, sendSuccess As Boolean

        ' 读取配置参数，统一做转义处理
        ACCESS_TOKEN = calcule.Range("C7").Value
        TARGET_DEVICE_IDEN = JsonEscape(calcule.Range("C8").Value)
        receiver_number = JsonEscape(Me.sms_nmbr.Text)
        ' 短信内容转义，解决多行发送失败问题
        text_message = JsonEscape(Me.sms_txt.Text)

        ' 初始化请求对象
        Set Request = CreateObject("MSXML2.ServerXMLHTTP.6.0")
        URL = "https://api.pushbullet.com/v2/texts"
        Request.Open "Post", URL, False
        Request.setRequestHeader "Access-Token", ACCESS_TOKEN
        Request.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
        
        ' 拼接合法JSON请求体
        postData = "{""data"":{""target_device_iden"":""" & TARGET_DEVICE_IDEN & """,""addresses"":[""" & receiver_number & """],""message"":""" & text_message & """}}"
        
        ' 发送请求+异常捕获
        On Error Resume Next
        Request.send postData
        If Err.Number <> 0 Then
            sendSuccess = False
            respText = "请求发送失败：" & Err.Description
            Err.Clear
        Else
            ' 根据HTTP状态码判断发送结果
            If Request.Status >= 200 And Request.Status < 300 Then
                sendSuccess = True
                respText = "短信发送成功"
            Else
                sendSuccess = False
                respText = "发送失败，错误码：" & Request.Status & "，错误信息：" & Request.responseText
            End If
        End If
        On Error GoTo 0

        ' 状态通知，可自行选择提示方式
        If sendSuccess Then
            ' 方式1：弹窗提示
            MsgBox respText, vbInformation, "操作成功"
            ' 方式2：按钮颜色提示（和原逻辑一致，注释掉上面的弹窗即可启用）
            ' Me.smsfac.ForeColor = vbGreen
            ' Application.Wait (Now + TimeValue("0:00:2"))
            ' Me.smsfac.ForeColor = &HFFFF00
        Else
            ' 方式1：弹窗提示
            MsgBox respText, vbCritical, "操作失败"
            ' 方式2：按钮颜色提示（和原逻辑一致，注释掉上面的弹窗即可启用）
            ' Me.smsfac.ForeColor = vbRed
            ' Application.Wait (Now + TimeValue("0:00:2"))
            ' Me.smsfac.ForeColor = &HFFFF00
        End If
    End If
End Sub

注意事项 #

• 请确认你用户窗体中sms_txt文本框的MultiLine属性已设置为True，否则输入时无法正常换行
• 不需要额外引用其他库，原有依赖Microsoft XML, v6.0保持不变即可

内容的提问来源于stack exchange，提问作者Youcef Merah