PatLac
XLDnaute Occasionnel
Bonjour à tous !
Je désire envoyer des SMS par l'intermédiaire d'une macro inclue dans une feuille Excel.
J'ai 2 codes : un qui fonctionne, et l'autre pas.
Celui qui fonctionne à une coût/SMS plus important que celui qui ne fonctionne pas
Je voudrais bien sur utiliser celui qui ne fonctionne actuellement pas , car 2 fois moins cher que celui qui fonctionne.
Je sollicite vos capacités en VBA pour m'aider.
Je mets ci-dessous les 2 codes et vous remercie pour votre bienséance.
Cordiales salutations.
Code fonctionnel
Code NON-FONCTIONNEL que vous pouvez retrouver ici également
Je désire envoyer des SMS par l'intermédiaire d'une macro inclue dans une feuille Excel.
J'ai 2 codes : un qui fonctionne, et l'autre pas.
Celui qui fonctionne à une coût/SMS plus important que celui qui ne fonctionne pas
Je voudrais bien sur utiliser celui qui ne fonctionne actuellement pas , car 2 fois moins cher que celui qui fonctionne.
Je sollicite vos capacités en VBA pour m'aider.
Je mets ci-dessous les 2 codes et vous remercie pour votre bienséance.
Cordiales salutations.
Code fonctionnel
Code:
Sub SendSMS()
Dim strReturn As String
Dim Apikey As String
Dim Number As String
Dim Message As String
Dim Expediteur As String
Dim i As Integer
Apikey = "VotreApiKey"
Message = Worksheets("Feuil1").Cells(2, 2).Value
Expediteur = Worksheets("Feuil1").Cells(1, 2).Value
i = 5
While (Worksheets("Feuil1").Cells(i, 1).Value <> "")
Worksheets("Feuil1").Cells(i, 2).Value = ""
Number = Worksheets("Feuil1").Cells(i, 1)
strReturn = send(Apikey, Number, URLEncode(Message), URLEncode(Expediteur), False)
Worksheets("Feuil1").Cells(i, 2).Value = strReturn
i = i + 1
Wend
End Sub
Function send(Apikey, Number, Message, Expediteur, MsgID) As String
Dim objWinHTTP As Object
Dim strReturn As String
Dim Request As String
Dim url As String
Set objWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
url = "http://www.envoyersms.org/api/v1/?method=send"
Request = "&apikey=" & URLEncode(Apikey) & "&number=" & URLEncode(Number)
Request = Request & "&message=" & URLEncode(Message)
Request = Request & "&expediteur=" & 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 Function
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 FunctionCode NON-FONCTIONNEL que vous pouvez retrouver ici également
Code:
Imports System.Diagnostics.CodeAnalysis
Imports System.Security.Principal
Imports System.Web.Routing
Imports System.Net
Imports System.IO
Imports System.Xml
Const ENVOYER_SMS_PRO_HOST As String = "www.envoyersmspro.com"
Const ENVOYER_SMS_PRO_PROTOCOL As String = "https://"
Const ENVOYER_SMS_PRO_LOGIN As String = ""
Const ENVOYER_SMS_PRO_PASSWORD As String = ""
Const ENVOYER_SMS_PRO_URL As String = "/api/message/send"
Dim strPost As String
' Build POST String
strPost = "text=" + System.Web.HttpUtility.UrlEncode("Nouveau message via l'API d'Envoyer SMS Pro depuis un script VB .NET") + "&recipients=" + System.Web.HttpUtility.UrlEncode("33600000000") + "&sendername=" + System.Web.HttpUtility.UrlEncode("SOCIETE")
' Create POST
Dim request As WebRequest = WebRequest.Create(ENVOYER_SMS_PRO_PROTOCOL + ENVOYER_SMS_PRO_HOST + ENVOYER_SMS_PRO_URL)
request.Method = "POST"
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(strPost)
Dim myCred As New NetworkCredential(ENVOYER_SMS_PRO_LOGIN, ENVOYER_SMS_PRO_PASSWORD, "")
request.ContentType = "application/x-www-form-urlencoded"
request.Credentials = myCred
request.ContentLength = byteArray.Length
Dim dataStream As Stream = request.GetRequestStream()
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
' Get the response.
Dim response As WebResponse = request.GetResponse()
dataStream = response.GetResponseStream()
Dim reader As New StreamReader(dataStream)
Dim responseFromServer As String = reader.ReadToEnd()
' Clean upthe streams.
reader.Close()
dataStream.Close()
response.Close()
' Return result to calling function
If responseFromServer.Length > 0 Then
Dim textResponse As String
' Create an XmlReader
Using readerXML As XmlReader = XmlReader.Create(New StringReader(responseFromServer))
readerXML.ReadToFollowing("status")
If readerXML.ReadElementContentAsString() = "success" Then
readerXML.ReadToFollowing("message_id")
textResponse = "Le messageid : " + readerXML.ReadElementContentAsString()
Else
textResponse = "Impossible d'envoyer le message"
While readerXML.Read()
' Check for start elements.
If readerXML.IsStartElement() Then
' See if perls element or article element.
If readerXML.Name = "request" Then
textResponse += "La requête : " + readerXML.ReadElementContentAsString + ControlChars.NewLine
textResponse += "L'errorid : " + readerXML.ReadElementContentAsString + ControlChars.NewLine
textResponse += "L'error message : " + readerXML.ReadElementContentAsString + ControlChars.NewLine
End If
End If
End While
End If
End Using
ViewData("Message") = textResponse
Else
ViewData("Message") = CType(response, HttpWebResponse).StatusDescription
End If
alors si tu ne trouves pas quelle est la bonne adaptation à faire, j'espère qu'un autre intervenant qui connaît mieux que moi les envois par SMS pourra t'aider davantage ! 
