Solved In MS Access if the VBA code is taking longer than required how do we force the code to next

N

nector

Member
Local time
Today, 19:49
Joined
Jan 21, 2020
Messages
575
The VBA code below sometimes takes more than twenty seconds to run, now a decision is made that if this code takes longer than 20 seconds then it should quit and move to the next code instead of rotating for 10 minutes on one code, for sure a timer is required, that is where it's getting interesting?


Code: 
Dim Request As Object
Dim stUrl As String
Dim Response As String
Dim requestBody As String
stUrl = "http://localhost:8080/XXXXXXXXXXXXXXXXXXXXXXXXX"
Set Request = CreateObject("MSXML2.XMLHTTP")
requestBody = strData
    With Request
        .Open "POST", stUrl, False
        .setRequestHeader "Content-type", "application/json"
        .Send requestBody
        Response = .ResponseText
    End With
If Request.Status = 200 Then
MsgBox Request.ResponseText, vbInformation, "Internal Audit Manager"
End If

Any idea on how to insert a timer and quit after 20 sends will be highly recommended
 
Code: 
With Request
        .Open "POST", stUrl, False
        .setRequestHeader "Content-Type", "application/json"
        .setTimeouts 5000, 5000, 5000, 5000 ' connect, send, receive, resolve
        .Send requestBody

        If .Status = 200 Then
            Response = .ResponseText
            MsgBox Response, vbInformation, "Internal Audit Manager"
        Else
            MsgBox "Server returned status: " & .Status & vbCrLf & .StatusText, vbExclamation, "Request Failed"
        End If
    End With
 
arnelgp said:
Code: 
With Request
        .Open "POST", stUrl, False
        .setRequestHeader "Content-Type", "application/json"
        .setTimeouts 5000, 5000, 5000, 5000 ' connect, send, receive, resolve
        .Send requestBody

        If .Status = 200 Then
            Response = .ResponseText
            MsgBox Response, vbInformation, "Internal Audit Manager"
        Else
            MsgBox "Server returned status: " & .Status & vbCrLf & .StatusText, vbExclamation, "Request Failed"
        End If
    End With
Click to expand...
Many thanks Let me test it properly at 14:00 hours then I will give feedback
 
nector said:
if this code takes longer than 20 seconds then it should quit
Click to expand...
You should keep in mind that even if your client code aborts the HTTP request after 20 seconds, the server might still successfully complete the operation after 20+x seconds. So, make sure submitting duplicate requests does not create some sort of chaos.
 
arnelgp said:
Code: 
With Request
        .Open "POST", stUrl, False
        .setRequestHeader "Content-Type", "application/json"
        .setTimeouts 5000, 5000, 5000, 5000 ' connect, send, receive, resolve
        .Send requestBody

        If .Status = 200 Then
            Response = .ResponseText
            MsgBox Response, vbInformation, "Internal Audit Manager"
        Else
            MsgBox "Server returned status: " & .Status & vbCrLf & .StatusText, vbExclamation, "Request Failed"
        End If
    End With
Click to expand...
The symptoms here is that the code can only abort when the internet is not there and keep on trying sending if the internet is there which is not what is required. Meaning the time limit is not relevant!

Business Rule:

Whether there is internet or not the code must allow only 10 seconds once the 10 seconds is over then it should abort completely and resume next NOT to Exit the code
 
nector said:
The symptoms here is that the code can only abort when the internet is not there and keep on trying sending if the internet is there which is not what is required. Meaning the time limit is not relevant!

Business Rule:

Whether there is internet or not the code must allow only 10 seconds once the 10 seconds is over then it should abort completely and resume next NOT to Exit the code
Click to expand...
So why not just send the request, sleep 10 seconds, and if status <> 200 then resume next?
 
BlueSpruce said:
So why not just send the request, sleep 10 seconds, and if status <> 200 then resume next?
Click to expand...
I think you wanted to suggest that I need to compose a code like below so that I simply call it like what you are saying because SLEEP function does not work on its own without a function support module in MS Access

Code: 
Option Compare Database

Option Explicit
#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If
Sub SleepTest()
Sleep 5000 'delay in milliseconds
End Sub

I will try to test it at 20:00 hours , but confirm if that is what you are talking about?
 
nector said:
I think you wanted to suggest that I need to compose a code like below so that I simply call it like what you are saying because SLEEP function does not work on its own without a function support module in MS Access

I will try to test it at 20:00 hours , but confirm if that is what you are talking about?
Click to expand...

Affirmative. We use sleep in several Access DotNet interop apps that talk to online services, like Quick Books Online.

QBOtest.PNG
 
Last edited:
You might wish to also consider that you potentially could create some 'ghost' processes by abandoning them before they finish. When you create Excel or Word app objects and abandon them without forcing a QUIT, they hang around as ghosts that continue to consume memory. I'm not saying this is something that WILL happen for you, but when you abandon an object, it COULD happen. So once you get the timers working, you need to check back later to verify that you don't have an accumulation of ghosts in your attic. (We ARE getting close to Halloween, after all...)
 
The_Doc_Man said:
You might wish to also consider that you potentially could create some 'ghost' processes by abandoning them before they finish. When you create Excel or Word app objects and abandon them without forcing a QUIT, they hang around as ghosts that continue to consume memory. I'm not saying this is something that WILL happen for you, but when you abandon an object, it COULD happen. So once you get the timers working, you need to check back later to verify that you don't have an accumulation of ghosts in your attic. (We ARE getting close to Halloween, after all...)
Click to expand...
Very true , that is why I'm trying to amend the code to use the code below but I seam not to get it right for whatever reasons:

Code: 
#If VBA7 Then<br>    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems<br>
#Else<br>    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems<br>
#End If

Sub SendRequestWithTimeout()
    Dim Request As Object
    Dim stUrl As String
    Dim Response As String
    Dim requestBody As String
    Dim startTime As Single
    
    stUrl = "http://localhost:8080/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
    Set Request = CreateObject("MSXML2.XMLHTTP")
    requestBody = strData
    
    With Request
        .Open "POST", stUrl, True
        .setRequestHeader "Content-type", "application/json"
        .Send requestBody
    End With
    
    startTime = Timer
    Do While Request.readyState <> 4
        DoEvents
        If Timer - startTime > 10 Then
            Exit Do
        End If
    Loop
    
    If Request.readyState = 4 Then
        Response = Request.ResponseText
        If Request.Status = 200 Then
            MsgBox Response, vbInformation, "Internal Audit Manager"
        End If
    Else
        MsgBox "No response after 10 seconds, continuing...", vbExclamation, "Timeout"
    End If
End Sub
 
You
nector said:
Very true , that is why I'm trying to amend the code to use the code below but I seam not to get it right for whatever reasons:

Code: 
#If VBA7 Then<br>    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems<br>
#Else<br>    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems<br>
#End If

Sub SendRequestWithTimeout()
    Dim Request As Object
    Dim stUrl As String
    Dim Response As String
    Dim requestBody As String
    Dim startTime As Single
   
    stUrl = "http://localhost:8080/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
    Set Request = CreateObject("MSXML2.XMLHTTP")
    requestBody = strData
   
    With Request
        .Open "POST", stUrl, True
        .setRequestHeader "Content-type", "application/json"
        .Send requestBody
    End With
   
    startTime = Timer
    Do While Request.readyState <> 4
        DoEvents
        If Timer - startTime > 10 Then
            Exit Do
        End If
    Loop
   
    If Request.readyState = 4 Then
        Response = Request.ResponseText
        If Request.Status = 200 Then
            MsgBox Response, vbInformation, "Internal Audit Manager"
        End If
    Else
        MsgBox "No response after 10 seconds, continuing...", vbExclamation, "Timeout"
    End If
End Sub
Click to expand...
You don't need to use the Timer event with sleep. Just put sleep 10000 after sending the request, and test for status <> 200.
 
BlueSpruce said:
You

You don't need to use the Timer event with sleep. Just put sleep 10000 after sending the request, and test for status <> 200.
Click to expand...
Code: 
With Request
        .Open "POST", stUrl, False
        .setRequestHeader "Content-type", "application/json"
        .Send requestBody
        Response = .ResponseText
    End With
Sleep (1000)
If Request.Status <> 200 Then
Resume Next
ElseIf Request.Status = 200 Then
MsgBox Request.ResponseText, vbInformation, "Internal Audit Manager"
Resume Next
End If

Yes this has worked ok many thanks to all the respondents
 
nectorch said:
Code: 
With Request
        .Open "POST", stUrl, False
        .setRequestHeader "Content-type", "application/json"
        .Send requestBody
        Response = .ResponseText
    End With
Sleep (1000)
If Request.Status <> 200 Then
Resume Next
ElseIf Request.Status = 200 Then
MsgBox Request.ResponseText, vbInformation, "Internal Audit Manager"
Resume Next
End If

Yes this has worked ok many thanks to all the respondents
Click to expand...
Sleep(1000) is only 1 second, for 10 seconds it has to be 10000 milliseconds.
 
Last edited:
nector said:
The symptoms here is that the code can only abort when the internet is not there and keep on trying sending if the internet is there which is not what is required. Meaning the time limit is not relevant!

Business Rule:

Whether there is internet or not the code must allow only 10 seconds once the 10 seconds is over then it should abort completely and resume next NOT to Exit the code
Click to expand...
I would recommend you then test the internet connectivity first, it's much more elegant than waiting to see if the house falls down later
 
Why in the world was I not using sleep when I was doing access dev? I thought that was only for WSCRIPT for some reason, I'd rolled my own make code wait type of routine. Has it always been available with the windows api declaration? Could have sworn I asked this make-code-wait question and got a negative in the past.
Maybe had to do with freezing the office application vs. not, can't remember
 
I wonder if I avoided it at the beginning because I wanted to do events during the sleep which that doesn't do
 
Isaac said:
I wonder if I avoided it at the beginning because I wanted to do events during the sleep which that doesn't do
Click to expand...
Sleep freezes the thread, and if it's long enough you'll see "Not Responding", whereas Application.Wait allows it to run while waiting for an event to complete.
 
The Sleep isn't native to vba, as you'll find out if you just type Sleep 1000 and try to run it, but it's available from the Windows api
 
You must log in or register to reply here.

Similar threads

N
Solved Saving one field from Json String received in MS Access
Replies
6
Views
1,184
saketaco
S
N
Solved Failing To Save Imported Data from the internet in Ms Access
Replies
6
Views
943
nector
N
N
VBA MS Access Error Handling
Replies
5
Views
1,072
Pat Hartman
P
N
Failing to access the server from VBA
Replies
5
Views
826
nector
N
N
Error Handling Code in Ms Access
Replies
10
Views
2,295
gemma-the-husky
gemma-the-husky

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom