Автор темы
Здравсвуйте.
Помогите переделать код vba так, чтобы при отправке смс информация бралась из запроса "отбор" (номер тел., на который будет отправляться смс, и вся инф. об объекте). И как сделать так, чтобы при добавлении клиента смс с инф. отправлялось автоматически и так же при добавлении нового объекта, (если он подходит по запросу клиента) этот вариант отправлялся ему.
И еще подскажите, как можно сделать ограничение по количеству отправленных смс одному клиенту (например, не более 300).
Заранее большое спасибо. Я просто новичок в этом вопросе.
Помогите переделать код vba так, чтобы при отправке смс информация бралась из запроса "отбор" (номер тел., на который будет отправляться смс, и вся инф. об объекте). И как сделать так, чтобы при добавлении клиента смс с инф. отправлялось автоматически и так же при добавлении нового объекта, (если он подходит по запросу клиента) этот вариант отправлялся ему.
И еще подскажите, как можно сделать ограничение по количеству отправленных смс одному клиенту (например, не более 300).
Заранее большое спасибо. Я просто новичок в этом вопросе.
Код:
Option Compare Database
Private Sub Кнопка0_Click()
If SMS("79087964781", "Привет") Then MsgBox ("Сообщение отправленно") Else MsgBox SMSError()
End Sub
' Функция для отправки SMS [url]http://www.smspilot.ru/apikey.php[/url]
Public Function SMS(Phone As String, Text As String) As Boolean
SMS = False
Set HttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "http://smspilot.ru/api.php"
URL = URL & "?send=" & URLEncode(Text)
URL = URL & "&to=" & Phone
' Своя подпись
' URL = URL & "&from=smspilot"
' (!) Заменить на свой API-ключ
URL = URL & "&apikey=XXXXXXXXXXXXYYYYYYYYYYYYZZZZZZZZXXXXXXXXXXXXYYYYYYYYYYYYZZZZZZZZ"
URL = URL & "&charset=windows-1251"
If HttpReq.Open("GET", URL, False) <> 0 Then
SMSError ("Connection error")
Exit Function
End If
If HttpReq.Send() <> 0 Then
SMSError ("Open URL " & URL & " error")
Exit Function
End If
If Left$(HttpReq.responseText, 7) <> "SUCCESS" Then
SMSError (HttpReq.responseText)
Exit Function
End If
SMS = True
SMSError ("")
End Function
' Функция для хранения последней ошибки
Public Function SMSError(Optional SetErr As String = "") As String
Static Err
If SetErr <> "" Then Err = SetErr
SMSError = Err
End Function
' Кодирование URL Параметров [url]http://ru.wikipedia.org/wiki/URL[/url]
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
