用于api的vba excel短信

Question

我希望每次我预约时，客户都会收到短信通知。 您会发现附加了一个用于发送短信的 vba 代码。 该脚本似乎正在执行。 另一方面，不要按预期发送短信。 请有人帮我弄清楚缺少什么

Sub send_SMS_RDV()


    Application.ScreenUpdating = False

        
        
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '''''''''essai code xfactor'''''''''''''''''''''
            Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
          Dim Recipient As String
           Dim Message As String
           
    Dim rowname As String
    Dim rowprestardv As String
    
    
    Dim rowtimerdv, rownumber, rowdaterdv, x  As String
    
    rowtimerdv = Worksheets("PLANNING").Range("I4").Value
    rowprestardv = Worksheets("PLANNING").Range("H4").Value
    rowname = Worksheets("PLANNING").Range("N4").Value
    rownumber = Worksheets("PLANNING").Range("O4").Value
    rowdaterdv = Worksheets("PLANNING").Range("Q4").Value
    
    
    x = "237"
    Recipient = "x&lastrownumber"
           

'
    If rowdaterdv = Worksheets("PLANNING").Range("P32").Value Then
'
        Message = "Dear  " & rowname & ",  your appointment has  been register at : " & rowtimerdv & " Contact us for any changes. Merci"
           Else
'
        Message = "Dear  " & rowname & ",  your appointment has  been register at : " & rowdaterdv & " Contact us for any changes. Merci"""

'
' 
        End If
           
           
            'Set vars where phone numbers and msg are set in your sheet'

            URL = api.smsfactor.com/send?text=" + Message + "&to=" + Recipient
            objHTTP.Open "GET", URL, False
            objHTTP.SetRequestHeader "Authorization", "Bearer eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzdWIiOiIzNDcwOSIsImlhdCI6MTYwMTk5NzM4N30.VbWdRwVwtIn5JtwNYjeJ8imnM_2bYskRIg2O6uZG5fA" 'Your Token'
            objHTTP.SetRequestHeader "Accept", "application/json"
            objHTTP.send ("")
        
        
        
      End Sub

     
    

Answer 1

您的 URL 变量看起来不对。那需要是一个字符串，但它不是一个正确的字符串。您缺少一个开始引号，并且您使用 + 进行连接，而我希望看到的是 &。

尝试将其更改为：

URL = "api.smsfactor.com/send?text=" & Message & "&to=" & Recipient

Answer 2

感谢您的贡献。 我解决了这个问题。 这是我为使其工作而进行的修改。

 Recipient = 237 & rownumber

网址之后

url = Replace(url, " ", "%20")

但是，我想使用另一个提供商进行配置，但又遇到了问题

Sub send_SMS_Fact()

    Application.ScreenUpdating = False
'   Declaring varibles for sending sms

    Dim objWinHTTP  As Object
    Dim response, send As String
    Dim sURL As String
    Dim API As String
    Dim SenderID As String
    Dim Recipient, Message As String
'   Declaring varibles for Application
    Dim rowname As String
    Dim rowtypevente As String
    
    
    Dim rowamount, rownumber, x  As String
    Worksheets("FACTURATION").Activate
    
    rowtypevente = Worksheets("FACTURATION").Range("H11").Text
    rowamount = Worksheets("FACTURATION").Range("M11").Text
    rowname = Worksheets("FACTURATION").Range("S11").Text
    rownumber = Worksheets("FACTURATION").Range("T11").Text
    
    
    API = "Um9kcnlnMTIzOnNhbG9tZQ=="
    x = "237"
    Recipient = x & rownumber
    SenderID = "TechSoft-SMS"
'   Preparation sms

    If rowtypevente = "VENTE DIFF" Then
        
        Message = "Dear  " & rowname & ",  The amount of your invoice which is: " & rowamount & " remains to be paid as soon as possible"
            Else
            rowtypevente = "VENTE"


        Message = "Dear  " & rowname & ",  We thank you for your loyalty and hope to have satisfied you. Best regards and see you soon"
    
    End If
'  Checking for valid mobile number

    If rownumber <> "700000000" Then

        
 

    Else
        Recipient = CStr(rownumber)

 
    End If



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''test protocole url'''''
    Set objWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

    sURL = app.techsoft-web-agency.com/sms/api"
    sURL = Replace(sURL, " ", "%20")
    Request = "&apikey=" & API & URLEncode(Apikey) & "&number=" & Recipient & URLEncode(Number)
    Request = Request & "&message=" & Message & URLEncode(Message)
    Request = Request & "&expediteur=" & SenderID & URLEncode(Expediteur) & "&msg_id=" & MsgID

    objWinHTTP.Open "GET", URL & Request, False
    objWinHTTP.SetTimeouts 30000, 30000, 30000, 30000
    objWinHTTP.send
    If objWinHTTP.StatusText = "OK" Then
        strReturn = objWinHTTP.ResponseText
        Debug.Print strReturn
    End If

    Set objWinHTTP = Nothing
    send = strReturn



End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function URLEncode(sRawURL) As String
    On Error GoTo Catch
    Dim iLoop As Integer
    Dim sRtn As String
    Dim sTmp As String
    Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz:/.?=_-$()~&"
    If Len(sRawURL) > 0 Then
        For iLoop = 1 To Len(sRawURL)
            sTmp = Mid(sRawURL, iLoop, 1)
            If InStr(1, sValidChars, sTmp, vbBinaryCompare) = 0 Then
                sTmp = Hex(Asc(sTmp))
                If sTmp = "20" Then
                    sTmp = "+"
                ElseIf Len(sTmp) = 1 Then
                    sTmp = "%0" & sTmp
                Else
                    sTmp = "%" & sTmp
                End If
            End If
            sRtn = sRtn & sTmp
        Next iLoop
        URLEncode = sRtn
    End If
Finally:
        Exit Function
Catch:
        URLEncode = ""
        Resume Finally
End Function

这就是我根据在他们网站上找到的文档配置新网址的方式。 但是在 "objWinHTTP.Open" GET ", URL & Request, False" 这一行我被告知该 url 使用了一个无法识别的协议