Send SMS from Excel VBA

Question

I have code for my Excel application. It\'s a membership loyalty program and every time members are billed it will send the current billed amount along with points earned or

Answer 1

Assume your SMS provide using a https get request, then here is example.

Sub Test_SMS()

'  //this should work with if winhttp.dll existing in system32 dir. 
'  Dim HttpReq  As New WinHttpRequest


Dim response As String
Dim sURL As String

' //another way to create the HttpReq
Set HttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

' // build your string
sURL = "https://malert.in/api/api_http.php?username=user&password=pwd&senderid=myid&to=9000000000& text=Hello%20world&route=Enterprise&type=text&datetime=2018-02-22%2012%3A54%3A22"

On Error Resume Next

With HttpReq
.Open "GET", sURL, False
.Send
End With

response = HttpReq.responseText
HttpReq.WaitForResponse
Debug.Print response

End Sub

Answer 2

Ok, I have figure it out and it's working. below is the code

Sub send_SMS(xyz As Integer)

    Application.ScreenUpdating = False
'   Declaring varibles for sending sms

    Dim HttpReq  As New WinHttpRequest
    Dim response As String
    Dim sURL As String
    Dim smsto, smstext As String
'   Declaring varibles for Application

    Dim lastrow, lastrow1, lastrow2, x, pointe As Long
    lastrow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    lastrow1 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
    lastrow2 = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row

'   Caculation of red card points

    If xyz = 1 Then
        pointe = (frmmain.txtpointe.Value - frmmain.txtpointr.Value) + (frmmain.txtamount.Value * 10 / 100)
        smstext = "Dear Member, You have reedemed " & frmmain.txtpointr.Text & " red points and your balance is " & pointe & " points"
    Else
        pointe = frmmain.txtpointe.Value + (frmmain.txtamount.Value * 10 / 100)
        If pointe >= 1000 Then

            smstext = "Dear Member, You have reached " & pointe & " red points and you can reedem it your next visit"
        Else

            smstext = "Dear Member, Your bill amount is " & frmmain.txtinvoice.Text & " and your Red Point balance is " & pointe & " Points"
        End If
    End If
'  Checking for valid mobile number

    If Len(frmmain.lblmobile.Caption) < 10 Then


      Call nomobile(pointe)

    Else
        smsto = CStr(frmmain.lblmobile.Caption)

        ' //another way to create the HttpReq
        Set HttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

        ' // API for sending sms
        sURL = "https://malert.in/api/api_http.php?username=username&password=password&senderid=REDHCP&to=" & smsto & "&text=" & smstext & "&route=Enterprise&type=text"
    '    Debug.Print sURL
        On Error Resume Next

        With HttpReq
        .Open "GET", sURL, False
        .send
        End With

        response = HttpReq.responseText
        HttpReq.waitForResponse
'        MsgBox Left(response, 2)
        Debug.Print response

            If Left(response, 2) = "OK" Then
                Call nomobile(pointe)
            Else
               Call errorconnection(smstext, pointe)
            End If
    End If
    sURL = "https://malert.in/api/api_http_balance.php?username=username&password=password&route=Enterprise"
    '    Debug.Print sURL
        On Error Resume Next

        With HttpReq
        .Open "GET", sURL, False
        .send
        End With

        response = HttpReq.responseText
        HttpReq.waitForResponse
        frmmain.lblstatus.Caption = response
        Debug.Print response
        Application.ScreenUpdating = True
End Sub