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 Function
	Code 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
	🙂