Takker for points. :-)
-- Skulle
http://www.textforce.com/sms_api/vb_example.htm gå ned, er indholdet af siden her:
------------------------------------------------------------------------------------------
VB example. It's not packaged up as it was provided by another client that is happy to share it.
Please note that technical support is not available for the code.
-----Start-----
The function has been created for Access 2000, but as Access uses the same VB engine as VB6, this should work OK.
You will need to create a reference to Microsoft Internet Transfer Control (msinet.ocx) as this is used for HTTP.
Create a form called frmInet containing a Microsoft Internet Transfer Control named Inet1
Add this code to form:
Option Explicit
Dim intState As Integer
Dim strPageReturn
Private Sub Inet1_StateChanged(ByVal State As Integer)
On Error GoTo ErrInet1_StateChanged
' Retrieve server response using the GetChunk
' method when State = 12.
Dim vtData As Variant
Dim strData As String
Dim bDone As Boolean: bDone = False
intState = State
Select Case State
' ... Other cases not shown.
Case icError ' 11
' In case of error, return ResponseCode and
' ResponseInfo.
vtData = Inet1.ResponseCode & ":" & _
Inet1.ResponseInfo
Case icResponseCompleted ' 12
' Get first chunk.
vtData = Inet1.GetChunk(1024, icString)
DoEvents
Do While Not bDone
strData = strData & vtData
' Get next chunk.
vtData = Inet1.GetChunk(1024, icString)
DoEvents
If Len(vtData) = 0 Then
bDone = True
End If
Loop
strPageReturn = strData
End Select
ExitInet1_StateChanged:
Exit Sub
ErrInet1_StateChanged:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume ExitInet1_StateChanged
End Sub
Property Get ControlState() As Byte
ControlState = intState
End Property
Property Get PageReturn() As String
PageReturn = strPageReturn
End Property
------------------------------------------------------------------------------------------
Create a function to be called for sending SMS
Function SendSMS(ByVal strMobile As String, ByVal strMessage As String, Optional strReturn As String, Optional IsHourGlass As Boolean = False) As Byte
‘Function to send an SMS text message using Text Force SMS gateway.
‘Returns a code to show if successful 1=successful, anything else shows an error
‘strMobile is a string containing one or more mobile numbers to send message to
‘strMessage is a string containg the message
‘strReturn is a string returning an error description, if not want function to show errors with message box replace lines
starting msgbox to strReturn =
‘IsHourGlass is flag to tell function whether to set hourglass on screen and clear after function is finished
‘Supplied as is by:
‘Datastore Computing Ltd, info@go-dcl.co.uk, Tel 07768 901944
On Error GoTo ErrSMSSend
Dim objInet As Inet
Dim strHeaders As String
Dim strData As String
Dim datStart As Date
Dim booTimeOut
Dim intSendSMS As Integer
Dim strUserName As String
Dim strPassword As String
Dim strURL As String
Dim strHeader
'If calling function has not declared its use of hourglass
'set the hourglass to show
If Not IsHourGlass Then
DoCmd.Hourglass True
End If
'Get the passwords etc to use
strUserName = “ENTER YOUR USERNAME SUPPLIED BY TEXT FORCE HERE”
strPassword = “ENTER YOUR PASSWORD SUPPLIED BY TEXT FORCE HERE”
strURL = “ENTER URL FOR TEXT FORCE GATEWAY HERE”
strHeader = “ENTER WHO YOU WANT MESSAGE TO SHOW AS COMING FROM”
'Check message is sendable
If Len(strMessage) > 160 Then
MsgBox "Unable to send SMS as message is longer than 160 characters.", vbInformation
GoTo ExitSMSSend
ElseIf strMessage = "" Then
MsgBox "There is no message to send.", vbInformation
GoTo ExitSMSSend
End If
If strMobile = "" Then
MsgBox "You must include at least one mobile number to send message to.", vbInformation
GoTo ExitSMSSend
End If
'Format the numbers to comma delimited with country code and no leading zero and no spaces
strMobile = Replace(strMobile, " ", "")
If Not IsNumeric(Replace(strMobile, ",", "")) Then
MsgBox "You can only send SMS messages to numbers"
GoTo ExitSMSSend
End If
If Left(strMobile, 2) = "00" Then
strMobile = Right(strMobile, Len(strMobile) - 2)
ElseIf Left(strMobile, 1) = "0" Then
strMobile = "44" & Right(strMobile, Len(strMobile) - 1)
End If
strMobile = Replace(strMobile, ",00", ",")
strMobile = Replace(strMobile, ",0", ",44")
'Make the message work with inet as & will be treated as a new variable. %26 will be changed back to & before sending
strMessage = Replace(strMessage, "&", "%26")
'Send the message
DoCmd.OpenForm "frmInet", , , , , acHidden
Set objInet = Forms!frmInet!Inet1.Object
strData = "username=" & strUserName & "&password=" & strPassword & "&originator=" & strHeader & "&numberlist=" & strMobile & "&message=" & strMessage
strHeaders = "Content-Type: application/x-www-form-urlencoded" & vbCrLf
objInet.Execute strURL, "POST", strData, strHeaders
'Look for return code or wait for time out and show error
datStart = Now
Do
DoEvents
booTimeOut = (DateDiff("n", datStart, Now()) >= 2) ‘Set for 2 minute timeout, adjust value after >= to max minutes to wait
Loop Until Forms!frmInet.ControlState = 12 Or booTimeOut
If booTimeOut Then
intSendSMS = 10
strReturn = "Timeout"
Else
strReturn = Trim(Replace(Replace(Replace(Forms!frmInet.PageReturn, Chr(9), ""), Chr(10), ""), Chr(13), ""))
If IsNumeric(Forms!frmInet.PageReturn) Then
intSendSMS = CInt(Forms!frmInet.PageReturn)
Else
intSendSMS = 11
End If
End If
If intSendSMS = 0 Then
SendSMS = 1
Else
SendSMS = intSendSMS
End If
Select Case intSendSMS
Case 0
MsgBox "SMS Message sent.", vbInformation
Case 99
MsgBox "Unable to send message due to error with mobile number. Please confirm mobile number.", vbInformation
Case 98
MsgBox "Unable to send message due to an unexpected error. The web site for sending the message is expecting a different layout.", vbInformation
Case 97
MsgBox "Unable to send message as there is not enough credit available.", vbInformation
Case 96
MsgBox "Unable to send message as the web site for sending the message has responded that the username or password is incorrect. Please contact system administrator.", vbInformation
Case 10
MsgBox "Unable to send message as the web site for sending the message is not responding, please try later.", vbInformation
Case 11
MsgBox "There was an unexpected problem with sending the message. The web site for sending the message responded as follows (please note the message and pass on to system administrator." & Chr(13) & Chr(10) & Chr(13) & Forms!frmInternetUpdate.PageReturn, vbInformation
Case Else
MsgBox "There was an unexpected problem sending the message, this may not have been sent. Return code = " & intSendSMS & ". Please pass this code on to system administrator.", vbInformation
End Select
ExitSMSSend:
On error resume next
DoCmd.Close acForm, "frmInternetUpdate"
'If calling function has not declared its use of hourglass
'set the hourglass to hide
If Not IsHourGlass Then
DoCmd.Hourglass False
End If
Exit Function
ErrSMSSend:
MsgBox "Error " & Err.Number & ": " & Err.Description
SendSMS = 20
Resume ExitSMSSend
End Function
Paul Edwards
Datastore Computing Ltd
Tel +44 (0)1268 473473
Mobile + 44(0)7768 901944
Email paul@go-dcl.co.uk
Web Site
www.go-dcl.co.uk
Ny bruger
Nybegynder
Opret
Preview
