从 Excel VBA 发送短信

Question

我有我的 Excel 应用程序的代码。这是一个会员忠诚度计划，每次向会员收费时，它都会发送当前的收费金额以及赚取或兑换的积分。

我购买了一个群发短信帐户，他们为我提供了 API。我需要在我的代码中使用这个 API。

以下是我的群发短信提供商提供的 API。

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

Answer 1

假设您的 SMS 使用 https 获取请求提供，那么这里是示例。

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

好的，我已经弄清楚了，它正在工作。下面是代码

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