VBA Excel的短信API

问题描述

我希望每次注册约会时，都会通过短信通知客户。 您会发现为此目的附加了一个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

     
    

解决方法

您的URL变量看起来不正确。那将是一个字符串，但不是正确的字符串。您缺少起始引号，并且正在使用+进行串联，而我希望看到的是&。

尝试将其更改为此：

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

,

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

 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
    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

这是我根据在其网站上找到的文档配置新url的方式。 但是在“ objWinHTTP.Open”行中，“ URL和请求为False”告诉我该URL使用了无法识别的协议