Microsoft 365 envoyer par boucle en 1 seul clic les sms du jour

[Usine à gaz]

Bonjour à toute et à tous,

Très récemment j'ai posté : https://www.excel-downloads.com/threads/sms-factor-adaptation-api-vers-excel-office365.20059862/

Avec l'aide de Excel Pratique et de mon fournisseur d'envois de sms,
nous avons pu modifier l'API du site en l'adaptant
Cet API codé VBA me permet de faire en un seul clic ce que je faisais auparavant en quasi 10 actions et allés et retours d'Excel vers le site et vice et versa.
Soit pour 1 sms = 9 actions et clics remplacés par 1 seul clic

Toujours pour gagner du temps, j'aimerais maintenant ce qui suit :
1 - je créé au préalable mes lignes de sms à envoyer
et :
J'aimerais inclure une boucle dans le code de l'API d'envoi
La boucle recherche correspondance avec "aujourd'hui" et envoie les sms 1 par 1
ligne par ligne
Exemple pour le 30/08/201 étant aujourd'hui :
sms 1 envoyé ligne 11 = téléphone ligne 11 col "D" - texte col "E"
sms 1 envoyé ligne 12 = téléphone ligne 12col "D" - texte col "E"
sms 1 envoyé ligne 13 = téléphone ligne 13 col "D" - texte col "E"
sms 1 envoyé ligne 14 = téléphone ligne 14 col "D" - texte col "E"
sms 1 envoyé ligne 15 = téléphone ligne 15 col "D" - texte col "E"
me permettant ainsi d'envoyer tous les sms du jour en 1seul clic
Mais voilà, mon niveau ne me permets pas d'inclure une boucle dans l'API
Pourriez-vous m'aider ?
En cas d'aide, je joins un fichier test.
Je vous remercie pour votre aide précieuse,
Amicalement,
lionel

 

[fanch55]

Salut Lionel,
Le code modifié mais non testé ( pas d'opérateur Sms ) ....

Sub SEND(Recipient As String, Message As String)
    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
'    Dim Recipient As String
'    Dim Message As String
    Dim Token As String
    'Set vars where phone numbers and msg are set in your sheet'
'    Recipient = Range("d4").Value
'    Message = Range("e4").Value

    Token = "eyJ0eXAiOiJKV1... etc..." ' <- mettre ton token ici

    Url = "https://api.smsfactor.com/send?text=" + Message + "&to=" + Recipient
    objHTTP.Open "GET", Url, False
    objHTTP.setRequestHeader "Authorization", "Bearer " & Token
    objHTTP.setRequestHeader "Accept", "application/json"
    objHTTP.SEND ("")
End Sub

Sub boucle()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    'Application.Calculation = xlManual
    Sheets("ma demande").Select
    For i = 3 To Range("C" & Rows.Count).End(xlUp).Row
        If Cells(i, 3) = Date Then '= [b1] à remplacer par "aujourd'hui
            SEND Cells(i, 4), Cells(i, 5)
'            Cells(i, 4).Select 'téléphone
'            Cells(i, 5).Select 'texte
            Cells(i, 7) = "vu"
        End If
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

Nota: par expérience et pour ton information, il va te falloir vérifier la longueur et le contenu du message
car un Sms contient 160 caractères et certains comptent double ...
Si ton message dépasse 160 cars, il comptera pour 2 sms ....
le message est surement transmis en mode HTML, ce qui veut dire qu'il faut remplacer certains cars :
Public Function HtmlCars(ByVal Message As String) As String
Message = Replace(Message, "ë", "ë")
Message = Replace(Message, "ê", "ê")
Message = Replace(Message, "é", "é")
Message = Replace(Message, "è", "è")
Message = Replace(Message, "ä", "ä")
Message = Replace(Message, "â", "â")
Message = Replace(Message, "à", "à")
Message = Replace(Message, "û", "û")
Message = Replace(Message, "ù", "ù")
HtmlCars = Message
End Function
Peut-être que ton opérateur a prévu autre chose, à toi de tester ...

 

[Usine à gaz]

Bonjour fanch55,
Merci pour ton code
Alors là ??? MAGIQUE lol
ça fonctionne sur mes tests
Nickel. un grand MERCI ainsi que pour tes conseils,
lionel

 

[Usine à gaz]

Bonsoir,

Après réflexion, je me suis dis qu'après l'envoi des sms du jour, il pourrait y avoir d'autres lignes ajoutées et d'autres sms à envoyer.

Pour ne pas envoyer 2 fois les mêmes sms, j'ai modifié le code comme ci-dessous :

Sub boucle()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    'Application.Calculation = xlManual
    Sheets("test").Select
    For i = 3 To Range("C" & Rows.Count).End(xlUp).Row
        If Cells(i, 7) = "" Then
        If Cells(i, 3) = Date Then
            SEND Cells(i, 4), Cells(i, 5)
            Cells(i, 7) = "envoyé"
        End If
        End If
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

Bonne fin de journée,
lionel

 

[Dudu2]

Pour les caractères de l'ASCII étendu de Windows, il faut passer par un transcodage (***).
Ce fichier donne 2 fonctions:
- Envoi d'un SMS SMS Factor
- Analyse de la réponse
Et une Macro de test de ces 2 fonctions.

(***) Edit: Attention ! Tous les caractères de l'ASCI étendu ne passent pas.
Seuls ceux du jeu de caractères GSM-7 seront traités comme documenté chez SMS Factor.