J
John
Hi
First of all apologies for posting so much code but this is rather involved
and I am totally stumped. Basically I have a main form (Staff Batch
SMS/E-Mail) which calls a function (SendSMS) in a module with in turn calls
a form (frmInet) which contains an ms internet control (Inet1). Problem is
that once the function Send SMS retunes and the code tries to close the main
form a 'Runtime error 2486: You can't carry out this action at present time'
error occurs. No matter what I try, I get no choice but to end task access
to come out. Any ideas what is causing the form to not close after the
SendSMS function is executed?
Thanks
Regards
= Code Below =======================================
'= Code in calling form 'Staff Batch SMS/E-Mail' ===================
Option Compare Database
Option Explicit
Private Sub Command41_Click()
Dim strReturn As String
If SendSMS(PhoneSt, Left(Me.Description, 160), strReturn, True) = 1 Then
DoCmd.Close acForm, "Staff Batch SMS/E-Mail" '<== Error on this line:
End If
End Sub
'= Code in Module SMS ===================================
Public Function SendSMS(ByVal strMobile As String, ByVal strMessage As
String, Optional strReturn As String, Optional IsHourGlass As Boolean =
False) As Byte
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
'Get the passwords etc to use
strUserName = SMSUser
strPassword = SMSPassword
strURL = SMSUrl
strHeader = IIf(IsNull(Forms![Staff Batch SMS/E-Mail]![Sender]), SMSHeader,
Forms![Staff Batch SMS/E-Mail]![Sender])
'Send the message
DoCmd.OpenForm "frmInet", , , , , acHidden
strHeaders = "Content-Type: application/x-www-form-urlencoded" & vbCrLf
Forms!frmInet!Inet1.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()) >= 0.5) '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 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, "frmInet"
Exit Function
ErrSMSSend:
MsgBox "Error " & Err.Number & ": " & Err.Description
SendSMS = 20
Resume ExitSMSSend
End Function
'Code in frmInet which contains an ms internet control inet1
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
strPageReturn = vtData
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
Dim a, b
a = InStr(strData, "<Response>") + 10
b = InStr(strData, "</Response>")
strPageReturn = Mid(strData, a, 2)
Debug.Print strPageReturn, strData
' MsgBox strPageReturn, , "Return data"
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
First of all apologies for posting so much code but this is rather involved
and I am totally stumped. Basically I have a main form (Staff Batch
SMS/E-Mail) which calls a function (SendSMS) in a module with in turn calls
a form (frmInet) which contains an ms internet control (Inet1). Problem is
that once the function Send SMS retunes and the code tries to close the main
form a 'Runtime error 2486: You can't carry out this action at present time'
error occurs. No matter what I try, I get no choice but to end task access
to come out. Any ideas what is causing the form to not close after the
SendSMS function is executed?
Thanks
Regards
= Code Below =======================================
'= Code in calling form 'Staff Batch SMS/E-Mail' ===================
Option Compare Database
Option Explicit
Private Sub Command41_Click()
Dim strReturn As String
If SendSMS(PhoneSt, Left(Me.Description, 160), strReturn, True) = 1 Then
DoCmd.Close acForm, "Staff Batch SMS/E-Mail" '<== Error on this line:
End If
End Sub
'= Code in Module SMS ===================================
Public Function SendSMS(ByVal strMobile As String, ByVal strMessage As
String, Optional strReturn As String, Optional IsHourGlass As Boolean =
False) As Byte
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
'Get the passwords etc to use
strUserName = SMSUser
strPassword = SMSPassword
strURL = SMSUrl
strHeader = IIf(IsNull(Forms![Staff Batch SMS/E-Mail]![Sender]), SMSHeader,
Forms![Staff Batch SMS/E-Mail]![Sender])
'Send the message
DoCmd.OpenForm "frmInet", , , , , acHidden
strHeaders = "Content-Type: application/x-www-form-urlencoded" & vbCrLf
Forms!frmInet!Inet1.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()) >= 0.5) '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 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, "frmInet"
Exit Function
ErrSMSSend:
MsgBox "Error " & Err.Number & ": " & Err.Description
SendSMS = 20
Resume ExitSMSSend
End Function
'Code in frmInet which contains an ms internet control inet1
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
strPageReturn = vtData
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
Dim a, b
a = InStr(strData, "<Response>") + 10
b = InStr(strData, "</Response>")
strPageReturn = Mid(strData, a, 2)
Debug.Print strPageReturn, strData
' MsgBox strPageReturn, , "Return data"
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