A Microsoft Office (Excel, Word) forum. OfficeFrustration

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » OfficeFrustration forum » Microsoft Access » Using Forms
Site Map Home Register Authors List Search Today's Posts Mark Forums Read  

Strange annoying problem - long chunk of code



 
 
Thread Tools Display Modes
  #1  
Old June 9th, 2004, 11:14 PM
John
external usenet poster
 
Posts: n/a
Default Strange annoying problem - long chunk of code

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.PageRet urn, 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



  #2  
Old June 10th, 2004, 03:37 AM
Allen Browne
external usenet poster
 
Posts: n/a
Default Strange annoying problem - long chunk of code

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.


 




Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Forum Jump


All times are GMT +1. The time now is 06:58 PM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 OfficeFrustration.
The comments are property of their posters.