VPF::Отправка смс из ms access - Форум программистов

Malua321

Дата 4.8.2013, 13:11 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 4.8.2013

Репутация: нет
Всего: нет

Здравсвуйте.
Помогите переделать код 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

Это сообщение отредактировал(а) Malua321 - 4.8.2013, 13:12

Присоединённый файл ( Кол-во скачиваний: 2 )

Database.rar 49,54 Kb

Rodman

Дата 13.8.2013, 11:00 (ссылка)

(нет голосов)

Загрузка ...

CIO

Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122

Добрый день
1. На сколько я знаю данные берутся из таблицы или запроса по одному и тому же принципу.
2. Чтобы при добавлении клиента отправлялась куда то информация - надо просто макрос на добавление повесить и этот макрос должен запускать код с отправкой
3. А ограничение: надо хранить данные об смсках... и оттуда считать количество.

--------------------

CRM с функцией АвтоОбзвона

Лотереи мира

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Программирование, связанное с MS Office \| Следующая тема »