Strange annoying problem - long chunk of code

[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 returns 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

 

[Allen Browne]

John, if you must post to multiple groups, could you nominate all the groups
at once instead of posting separate messages to different groups. At least
that way the replies are integrated.