Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Envoyer SMS par feuille excel via Macro - CODE EXISTANT à modifier

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

 

Staple1600

XLDnaute Barbatruc
Bonjour fanch55

[Suggestion en passant avant l'apéro du samedi]
En ces temps de COVID, j'encourage Escouger a créer sa propre discussion.
Ainsi , on évitera les miasmes de 2013 et on repartirta sur de bonnes bases, cellules grandes ouvertes pour aérer le Tableur
[/Suggestion en passant avant l'apéro du samedi]
 

soan

XLDnaute Barbatruc
Inactif
Bonsoir BrunoM45, Staple, fanch, le fil,

tu as écrit : « Désolé, je n'ai pas compris l'allusion »

comme au début tes 2 autres smileys étaient collés tout contre j'ai cru que c'était ironique, et que tu plaisantais ; puis j'ai vu ta phrase : « Moi son avatar je le vois blanc » ; alors j'ai compris qu'c'était pas ironique ; mais là, j'comprends pas, car moi j'ai ceci :​



j'ai seulement tronqué la largeur de l'image pour qu'elle prenne moins de place, y'a pas d'autre retouche d'image ! tu comprends maint'nant pourquoi j'ai dit qu'j'ai cru qu'c'était toi ! mébon, comme t'as écrit qu'y'a pas d'royalties sur l'œil na'vi de ton avatar, no problem ! faudra juste que j'fasse attention d'pas confondre les différents schtroumpfs ! suggestion : comme tu peux pas mettre un avatar de la schtroumpfette, tu peux pas mettre un avatar de celui avec son bonnet rouge ? oui, c'est ça, le Grand Schtroumpf ; j'dis pas qu'ça t'rajeunira, mais tu pourras bénéficier de sa grande sagesse, acquise au bout de longues années d'expérience ; tu pourras aussi nous préparer quelques unes de tes potions, qui sont des applications directes de tes formules Excel lues dans tes anciens grimoires d'alchimie ; sauf que j'préfère quand même la salsepareille et le jus d'framboise ! attention quand même :





j'adore ta phrase : « rien n'est plus gratuit dans ce monde arf si, l'aide sur les forums » ; ah ben voilà ! t'as enfin trouvé l'explication du mystère du crossposting ! (celui que t'aime tant !)

réponse de Bruno : il vaut mieux éviter les sujets qui fâchent !

soan
 
Dernière édition:
C

Compte Supprimé 979

Guest
j'adore ta phrase : « rien n'est plus gratuit dans ce monde arf si, l'aide sur les forums » ; ah ben voilà ! t'as enfin trouvé l'explication du mystère du crossposting ! (celui que t'aime tant !)
@soan, juste à ce sujet qui ne me fache pas du tout

Pour moi le crossposting, c'est tout bonnement un manque d'éducation et surtout de respect vis à vis des bénévoles que nous sommes

Et la réponse : "je le fais car j'obtiens plus de réponses sur lesquelles me baser"
à mes yeux c'est juste du pipi de chat c'est tout bonnement que les gens sont pressés et veulent avoir des réponses rapides à ça moi je dis FCK
 

soan

XLDnaute Barbatruc
Inactif
@BrunoM45

oui, c'est une façon de voir ; moi non plus, je n'aime pas trop le crossposting, mais d'un autre côté, j'me dis qu'on est en démocratie, et que si un « client » (un membre) choisit d'aller « faire ses courses » chez Leclerc (par exemple sur le site Excel-Pratique), on n'a aucun droit de lui dire : « puisque vous êtes allés chez Leclerc, vous n'avez plus le droit d'aller faire des courses chez Carrefour (le site CommentÇaMarche) ou chez Cora (le site XLD) » ; mais à condition, bien sûr, qu'il n'oublie pas de prévenir sur les autres forums que ce n'est plus la peine de chercher s'il a trouvé une solution qui lui convient ; avec ce bémol : s'il a envie d'avoir plusieurs réponses différentes, pour pouvoir les comparer et choisir la réponse qu'il préfère, pourquoi pas ? il ne restera plus alors qu'un seul gros problème : s'il n'arrive pas à choisir entre les différentes solutions, est-ce que tu seras d'accord pour bien vouloir l'aider à choisir ? non, Bruno, tu n'as pas le droit d'étrangler le « client » ! David préfère si tu peux préserver la santé des membres et autres visiteurs du site XLD !

soan
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

[Pour infos]
Et dans la série [Oncle Staple raconte]
Avant l'internet d'aujourd'hui, il y avait l'internet d'hier
Il est toujours bon de savoir d'où on vient.
Pour les curieux (et/ou les moins de 20 ans)
Take me back in 1995
[/Oncle Staple raconte]

NB: Rien n'empêche de signaler qu'on a posé sa question à plusieurs endroits (et le cas échéant de mettre un lien vers les principaux sites)

Quant à la démocratie...Vu qu'elle n'entrave que dalle à Excel, ce n'est ni le lieu, ni l'endroit pour une autre histoire d'Oncle Staple

PS: Escourger a du faire une crise d'asthme avec la poussière de 2013.

J'ai point vu de nouvelle discussion relative aux SMS s'affichée sur XLD.
 

Discussions similaires

Réponses
2
Affichages
267
Réponses
6
Affichages
308
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…