vba excel sms для api

#vba #api #sms #excel-2007

#vba #API #sms #excel-2007

Вопрос:

Я бы хотел, чтобы каждый раз, когда я регистрирую встречу, клиент получает уведомление по sms. Вы найдете прилагаемый код vba для этой цели для отправки sms. Сценарий, похоже, выполняется. С другой стороны, не доставляйте sms, как ожидалось. Кто-нибудь, кто поможет мне выяснить, чего не хватает, пожалуйста

 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 = "xamp;lastrownumber"
           

'
    If rowdaterdv = Worksheets("PLANNING").Range("P32").Value Then
'
        Message = "Dear  " amp; rowname amp; ",  your appointment has  been register at : " amp; rowtimerdv amp; " Contact us for any changes. Merci"
           Else
'
        Message = "Dear  " amp; rowname amp; ",  your appointment has  been register at : " amp; rowdaterdv amp; " 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   "amp;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

     
    
  

Комментарии:

1. Используйте Option Explicit , чтобы убедиться, что все ваши переменные объявлены правильно.

2. Вы только что разместили свой частный токен API в общедоступном Интернете? Я думаю, что теперь любой может отправить SMS, используя вашу учетную запись.

Ответ №1:

Ваша URL переменная выглядит неправильно. Это должна быть строка, но это не правильная строка. Вам не хватает начальной кавычки, и вы используете для конкатенации, где я ожидал бы увидеть amp; вместо этого.

Попробуйте изменить его на это:

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

Ответ №2:

Спасибо за ваш вклад. Я решил проблему. вот что я изменил, чтобы заставить его работать.

  Recipient = 237 amp; rownumber
  

и после URL

 url = Replace(url, " ", " ")
  

Тем не менее, я хотел бы настроить с другим поставщиком, но снова возникли проблемы

 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 amp; rownumber
    SenderID = "TechSoft-SMS"
'   Preparation sms

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


        Message = "Dear  " amp; rowname amp; ",  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 = "amp;apikey=" amp; API amp; URLEncode(Apikey) amp; "amp;number=" amp; Recipient amp; URLEncode(Number)
    Request = Request amp; "amp;message=" amp; Message amp; URLEncode(Message)
    Request = Request amp; "amp;expediteur=" amp; SenderID amp; URLEncode(Expediteur) amp; "amp;msg_id=" amp; MsgID

    objWinHTTP.Open "GET", URL amp; 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:/.?=_-$()~amp;"
    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" amp; sTmp
                Else
                    sTmp = "%" amp; sTmp
                End If
            End If
            sRtn = sRtn amp; sTmp
        Next iLoop
        URLEncode = sRtn
    End If
Finally:
        Exit Function
Catch:
        URLEncode = ""
        Resume Finally
End Function
  

Вот как я настроил новый URL-адрес в соответствии с документацией, которую я нашел на их сайте.
Но в строке «objWinHTTP.Open» GET «, URL и запрос, False» мне говорят, что URL использует нераспознанный протокол