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. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
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
|
|||
|
|||
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 | |
|
|