• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Send SMS Excel vba

David_4512

New Member
Hello. I have this API for sending SMS. The text is in Unicode.


RETURN CODE VALUES
------------------
0000 - Operation successful
0001 - Internal error (wrong IP)
0003 - Invalid request
0005 - Empty message
0007 - MSISDN error (wrong Phone Number)
0009 - Not Allowed

The numbers are in column A. The text is in column B. I want to send the number in cell A1 to the text in cell B1. And so on. I want to show the result in column C.

Username [username] is I1. pass [password] is i2

I tried ChatGPT, it helped me, but this code doesn't work

In cell C it writes an unknown error and for example, number 10 is recorded and sends to the number in the last cell only. And writes an unknown error in cell C


Sub SendUnicodeSMSOneByOne()
Dim username As String
Dim password As String
Dim phone_number As String
Dim sms_body As String
Dim api_url As String
Dim request_url As String
Dim response_code As String
Dim i As Integer
Dim http As Object

' Retrieve username and password from cells I1 and I2
username = ThisWorkbook.Sheets("Sheet1").Range("I1").Value ' Username in I1
password = ThisWorkbook.Sheets("Sheet1").Range("I2").Value ' Password in I2

' Initialize HTTP request object
Set http = CreateObject("MSXML2.ServerXMLHTTP")

' Loop through each row in columns A (Phone Numbers) and B (SMS Body)
i = 2 ' Start at row 2, assuming headers in row 1
Do While ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value <> ""
' Retrieve phone number and message from columns A and B
phone_number = ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value ' Phone number in column A
sms_body = ThisWorkbook.Sheets("Sheet1").Cells(i, 2).Value ' SMS body in column B

' Encode SMS body for Unicode compatibility
sms_body = URLEncode(sms_body)

' Construct the API request URL
api_url = "http : // x.x.x.x:1234/api/sendmsg.php?utf=1&"
request_url = api_url & "username=" & username & "&password=" & password & "&num=" & phone_number & "&msg=" & sms_body

' Send HTTP GET request
http.Open "GET", request_url, False
http.Send

' Get response code
response_code = http.responseText

' Log response code in column C
ThisWorkbook.Sheets("Sheet1").Cells(i, 3).Value = response_code

' Check for error codes and log messages in column C
Select Case response_code
Case "0000"
ThisWorkbook.Sheets("Sheet1").Cells(i, 3).Value = "Operation successful"
Case "0001"
ThisWorkbook.Sheets("Sheet1").Cells(i, 3).Value = "Internal error (wrong IP)"
Case "0003"
ThisWorkbook.Sheets("Sheet1").Cells(i, 3).Value = "Invalid request"
Case "0005"
ThisWorkbook.Sheets("Sheet1").Cells(i, 3).Value = "Empty message"
Case "0007"
ThisWorkbook.Sheets("Sheet1").Cells(i, 3).Value = "MSISDN error (wrong Phone Number)"
Case "0009"
ThisWorkbook.Sheets("Sheet1").Cells(i, 3).Value = "Not Allowed"
Case Else
ThisWorkbook.Sheets("Sheet1").Cells(i, 3).Value = "Unknown error"
End Select

' Wait for 2 seconds before sending the next message (optional)
Application.Wait (Now + TimeValue("00:00:02"))

' Move to the next row
i = i + 1
Loop

' Clean up
Set http = Nothing
End Sub

' Function to URL-encode the SMS body for Unicode support
Function URLEncode(UnicodeText As String) As String
Dim i As Integer
Dim CharCode As String
Dim EncodedText As String

EncodedText = ""

For i = 1 To Len(UnicodeText)
CharCode = Mid(UnicodeText, i, 1)
If CharCode Like "[A-Za-z0-9]" Then
EncodedText = EncodedText & CharCode
Else
EncodedText = EncodedText & "%" & Right("0" & Hex(AscW(CharCode)), 2)
End If
Next i

URLEncode = EncodedText
End Function
 
Back
Top