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 get请求提供，那么这是示例。

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

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

子send_SMS（xyz为整数）

Application.ScreenUpdating = False

'声明要发送短信的变量

Dim HttpReq  As New WinHttpRequest
Dim response As String
Dim sURL As String
Dim smsto, smstext As String

'声明要使用的变量

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

'计算红卡积分

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

'正在检查有效的手机号码

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（响应，2） Debug.Print响应

        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

结束子

从Excel VBA发送短信

2 个答案: