VBA code to send sms from a website amendment needed

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
Code:
Sub SendSMS()

    Dim URL As String
    Dim ApiKey As String
    Dim httpRequest As Object
    Dim responseText As String
    Dim values As String
    
    URL = "https://sms.arkesel.com/api/v2/sms/send"
    ApiKey = "RlBrQ21ISXlhTnJuZXNmQnJFZVhEcmxFa0U"
    
    Set httpRequest = CreateObject("MSXML2.XMLHTTP")
    
    httpRequest.Open "POST", URL, False
    
    ' Set request headers
    httpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    httpRequest.setRequestHeader "api-key", ApiKey
    
    ' Set request body
    values = "sender=Thank You&message=Hello World from VB6&recipients[]=XXXXXXXXXX"
    httpRequest.send values
    
    ' Get response text
    responseText = httpRequest.responseText
    
    ' Print response text to immediate window
    Debug.Print responseText

End Sub

Hi everyone,
I have this code here for sending sms.

I used chatGpt to covert it from VB to VBA as seen above.

The thing is that on this line:
Code:
values = "sender=Thank You&message=Hello World from VB6&recipients[]=XXXXXXXXXX"

I want to store the message in a variable and call it later. Something like this:
Code:
text1 = “Hello world “
text2 = “Help me out”

myVar = text1 & text2

values = "sender=Thank You&message=myVar&recipients[]=XXXXXXXXXX"

But can’t do that because the syntax is not a familiar one for me.

Can someone help me fix it?

Thanks in advance
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

Attachments

  • Untitled.png
    Untitled.png
    103 KB · Views: 9
Upvote 0
Make sure you have enabled
Microsoft WinHTTP Services, Version x.x

Try this and let's see how it goes.

Code:
Sub SendMultiSMS()
    Dim url As String
    Dim r As Range
    Dim db As Object
    Dim lr As Long
    Dim rng As Range
    Dim sName As String
    Dim sTell As String
    Dim sDebt As Double
   
    Dim content As String
    Dim key As Variant
    Dim PosRes As Long
   
    Dim apiKey As String
    Dim client As Object
   
    If MsgBox("Are you sure about this?", vbYesNo + vbExclamation + vbDefaultButton2, "XXXXXXXXX") <> vbYes Then
       
        Exit Sub
    End If
   
    apiKey = "YOUR APIKEY HERE"
    url = "https://sms.arkesel.com/api/v2/sms/send"
    Set client = CreateObject("WinHttp.WinHttpRequest.5.1")
    client.Open "POST", url, False
    client.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    client.SetRequestHeader "api-key", apiKey
   
    Dim values As New Scripting.Dictionary
   
    values("sender") = "DebtAlert"
   
    Set db = Sheets("Data")
    lr = db.Cells(Rows.Count, "B").End(xlUp).Row
   
    With Application
        .ScreenUpdating = False
        PosRes = 0
        If lr > 1 Then
            Set rng = db.Range("B2:B" & lr)
            For Each r In rng
                content = ""
               
                sName = r.Offset(0, 0) ' NAMES ARE IN COLUMN B
                sTell = r.Offset(0, 1) ' PHONE NUMBERS ARE IN COLUMN C
                sDebt = r.Offset(0, 2) ' DEBTS ARE IN COLUMN D
               
               If Len(.Trim(sTell)) Then
                   values("message") = "Hello" & sName & ", please be reminded of your outstanding balance of " & _
                   sDebt & " from last quarter. We are kindly asking you to pay before starting of the next term" & vbCrLf & _
                   "Thank you."

                   values("recipients[]") = sTell
                   For Each key In values.keys
                       content = content & key & "=" & values(key) & "&"
                   Next key
          
                   content = Left(content, Len(content) - 1)
                   client.Send content
                  
                  If client.Status = 200 Then PosRes = PosRes + 1
               End If
            Next r
           
            MsgBox PosRes & " messages were sent", vbInformation, "Delivery report"
        End If
        .ScreenUpdating = True
    End With
End Sub
I have been trying this the whole day.
I even tried in different versions of Office. I have seen it running almost perfectly in Excel 2010 to a point of returning "0 messages were sent". U fortunately I have a balance of 208 sms, why doesn't it send messages then?
 
Upvote 0
so I have tried to send the sms from my pc to the numbers on your sheet and I am getting the 0 sms sent alert.

Now here are a few questions:
1. Which country are you from? Kenya?
2. Are those numbers valid phone numbers?

Regards
Kelly
 
Upvote 0
so I have tried to send the sms from my pc to the numbers on your sheet and I am getting the 0 sms sent alert.

Now here are a few questions:
1. Which country are you from? Kenya?
2. Are those numbers valid phone numbers?

Regards
Kelly
Am from Tanzania. and those numbers are mine. they are valid.
 
Upvote 0
In that case, try this code

Code:
Sub SendMultiSMS()
    Dim url As String
    Dim r As Range
    Dim db As Object
    Dim lr As Long
    Dim rng As Range
    Dim sName As String
    Dim sTell As String
    Dim sDebt As Double
    
    Dim content As String
    Dim key As Variant
    Dim PosRes As Long
    
    Dim apiKey As String
    Dim client As Object
    
    If MsgBox("Are you sure about this?", vbYesNo + vbExclamation + vbDefaultButton2, "XXXXXXXXX") <> vbYes Then
        
        Exit Sub
    End If
    
    apiKey = "YOUR APIKEY HERE"
    url = "https://sms.arkesel.com/api/v2/sms/send"
    Set client = CreateObject("WinHttp.WinHttpRequest.5.1")
    client.Open "POST", url, False
    client.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    client.SetRequestHeader "api-key", apiKey
    
    Dim values As New Scripting.Dictionary
    
    values("sender") = "DebtAlert"
    
    Set db = Sheets("Data")
    lr = db.Cells(Rows.Count, "B").End(xlUp).Row
    
    With Application
        .ScreenUpdating = False
        PosRes = 0
        If lr > 1 Then
            Set rng = db.Range("B2:B" & lr)
            For Each r In rng
                content = ""
                
                sName = r.Offset(0, 0) ' NAMES ARE IN COLUMN B
                sTell = r.Offset(0, 1) ' PHONE NUMBERS ARE IN COLUMN C
                sDebt = r.Offset(0, 2) ' DEBTS ARE IN COLUMN D
                

sTell = "+255" & mid (sTell, 2)


               If Len(.Trim(sTell)) Then
                   values("message") = "Hello" & sName & ", please be reminded of your outstanding balance of " & _
                   sDebt & " from last quarter. We are kindly asking you to pay before starting of the next term" & vbCrLf & _
                   "Thank you."

                   values("recipients[]") = sTell
                   For Each key In values.keys
                       content = content & key & "=" & values(key) & "&"
                   Next key
           
                   content = Left(content, Len(content) - 1)
                   client.Send content
                   
                  If client.Status = 200 Then PosRes = PosRes + 1
               End If
            Next r
            
            MsgBox PosRes & " messages were sent", vbInformation, "Delivery report"
        End If
        .ScreenUpdating = True
    End With
End Sub

Regards
Kelly
 
Upvote 0
In that case, try this code

Code:
Sub SendMultiSMS()
    Dim url As String
    Dim r As Range
    Dim db As Object
    Dim lr As Long
    Dim rng As Range
    Dim sName As String
    Dim sTell As String
    Dim sDebt As Double
   
    Dim content As String
    Dim key As Variant
    Dim PosRes As Long
   
    Dim apiKey As String
    Dim client As Object
   
    If MsgBox("Are you sure about this?", vbYesNo + vbExclamation + vbDefaultButton2, "XXXXXXXXX") <> vbYes Then
       
        Exit Sub
    End If
   
    apiKey = "YOUR APIKEY HERE"
    url = "https://sms.arkesel.com/api/v2/sms/send"
    Set client = CreateObject("WinHttp.WinHttpRequest.5.1")
    client.Open "POST", url, False
    client.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    client.SetRequestHeader "api-key", apiKey
   
    Dim values As New Scripting.Dictionary
   
    values("sender") = "DebtAlert"
   
    Set db = Sheets("Data")
    lr = db.Cells(Rows.Count, "B").End(xlUp).Row
   
    With Application
        .ScreenUpdating = False
        PosRes = 0
        If lr > 1 Then
            Set rng = db.Range("B2:B" & lr)
            For Each r In rng
                content = ""
               
                sName = r.Offset(0, 0) ' NAMES ARE IN COLUMN B
                sTell = r.Offset(0, 1) ' PHONE NUMBERS ARE IN COLUMN C
                sDebt = r.Offset(0, 2) ' DEBTS ARE IN COLUMN D
               

sTell = "+255" & mid (sTell, 2)


               If Len(.Trim(sTell)) Then
                   values("message") = "Hello" & sName & ", please be reminded of your outstanding balance of " & _
                   sDebt & " from last quarter. We are kindly asking you to pay before starting of the next term" & vbCrLf & _
                   "Thank you."

                   values("recipients[]") = sTell
                   For Each key In values.keys
                       content = content & key & "=" & values(key) & "&"
                   Next key
          
                   content = Left(content, Len(content) - 1)
                   client.Send content
                  
                  If client.Status = 200 Then PosRes = PosRes + 1
               End If
            Next r
           
            MsgBox PosRes & " messages were sent", vbInformation, "Delivery report"
        End If
        .ScreenUpdating = True
    End With
End Sub

Regards
Kelly
 

Attachments

  • Picha.png
    Picha.png
    93.9 KB · Views: 9
Upvote 0

Forum statistics

Threads
1,223,897
Messages
6,175,269
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top