#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 использует нераспознанный протокол