Отправка Смс Из Ms Access

Тема в разделе "Visual Basic", создана пользователем Malua321, 4 авг 2013.

  1. Malua321

    Malua321 New Member

    Регистрация:
    4 авг 2013
    Сообщения:
    1
    Симпатии:
    0
    Здравсвуйте.
    Помогите переделать код vba так, чтобы при отправке смс информация бралась из запроса "отбор" (номер тел., на который будет отправляться смс, и вся инф. об объекте). И как сделать так, чтобы при добавлении клиента смс с инф. отправлялось автоматически и так же при добавлении нового объекта, (если он подходит по запросу клиента) этот вариант отправлялся ему.
    И еще подскажите, как можно сделать ограничение по количеству отправленных смс одному клиенту (например, не более 300).
    Заранее большое спасибо. Я просто новичок в этом вопросе.
    Код (LotusScript):
    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
     

    Вложения:

    • Database.rar
      Размер файла:
      49,5 КБ
      Просмотров:
      2
Загрузка...
Похожие Темы - Отправка Смс Из
  1. JohnLemon
    Ответов:
    6
    Просмотров:
    2.119
  2. JohnLemon
    Ответов:
    0
    Просмотров:
    1.057
  3. morpheus
    Ответов:
    14
    Просмотров:
    5.784
  4. k85
    Ответов:
    4
    Просмотров:
    113
  5. k85
    Ответов:
    10
    Просмотров:
    883

Поделиться этой страницей