VBA XMLHTTP 'Out-of-memory' state - vba

Question

Here is a piece of code that should connect to a web page with contents as follows: link1, description1, otherdata1, link2, description2, otherdata2, ..., linkN, descriptionN, otherdataN where N is 30 000 +.
From these links, the program finds one link of interest using regex, goes to that link, and downloads a file from there.
My problem is: at htmlWebInterfaceXML.send the program frequently, but not always, runs out of memory ('out-of-memory' error). It is difficult for me to test different solutions because normally the program runs smoothly, and it is difficult to notice changes if any.
Additional info:
It runs smoothly on some PCs and does not work for others
It usually runs until afternoon and throws an error then
Other infos that may be helpful:
the code shown is a private method of class and the class itself is a small part of the source code
other subs called which I do not explain are not relevant and run smoothly, the probelm always appears at htmlWebInterfaceXML.send.
One guess of mine is that I have declared local variable inside of a function that holds a very large object and can cause a stack overflow but it seems unlikely as VBA should handle those things on its own. Maybe you see a problem that I don't? Thank you.
Private Sub FileUpload()
' THE FUNCTION CANNOT BE CONNECTING FOR EACH CONTRACT ID! WILL TAKE TOO MUCH TIME - NEED TO ALTER
Dim member As Variant
Dim byteCounter As Byte
Dim byteMaxID As Byte
Dim strPathToXMLFile As String
Dim strURLToXMLFile
Dim strXMLFileStorageName As String
Dim domdocXMLText As New MSXML2.DOMDocument
Dim clctStrFoundMatches As New Collection
Dim clctInternalIDs As New Collection
Dim vrntContractID As Variant
Dim htmlHTMLMainPageXMLInterface As New MSHTML.HTMLDocument
Dim htmlTagElement As Variant
Dim htmclctFoundXMLs As MSHTML.IHTMLElementCollection
Dim htmlWebInterfaceXML As MSXML2.XMLHTTP60
Dim intNumberOfTradeUnderProcessing As Integer
UpdateProgressStatus "LOADING SERVER WITH SOURCE XML..." '<----------- UPDATE PROGRESS!
'----------------------> OPEN AND LOAD THE WEB SERVER, AND STORE ITS HTML INTO AN OBJECT
Set htmlWebInterfaceXML = New MSXML2.XMLHTTP
With htmlWebInterfaceXML
.Open "GET", p_cstrWebInterfaceXMLRootDirectory, False
.setRequestHeader "Authorization", "Basic" & Base64Encode( _
p_cstrXMLWebInterfaceAuthenticationUser & ":" & p_cstrXMLWebInterfaceAuthenticationPassword)
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
End With
htmlHTMLMainPageXMLInterface.body.innerHTML = htmlWebInterfaceXML.responseText ' how much text is the htmldocument able to store??
Set htmlWebInterfaceXML = Nothing
SetUpDirectory ' ------------> create or set directory where to store XML files
If Me.ContractiDs.Count <> Me.MailParts.Count And Me.ContractiDs.Count <> Me.MailParts.Count * 2 Then
Err.Raise 1504, "FileUpload", p_cstrError1504Message
Else
For Each vrntContractID In Me.ContractiDs
intNumberOfTradeUnderProcessing = intNumberOfTradeUnderProcessing + 1
UpdateProgressStatus "LOADING XML FOR THE TRADE NUMBER " & intNumberOfTradeUnderProcessing & "..." ' ----------------> UPDATE STATUS BAR
' ------------------------> find the tags containing the needed contract id in their names
Set htmclctFoundXMLs = htmlHTMLMainPageXMLInterface.getElementsByTagName("a")
Set clctStrFoundMatches = New Collection
For Each htmlTagElement In htmclctFoundXMLs
If htmlTagElement.getAttribute("href") Like "*" & vrntContractID & "*" Then
clctStrFoundMatches.Add htmlTagElement
End If
Next htmlTagElement
If clctStrFoundMatches.Count = 0 Then Err.Raise 1506, "FileUpload", p_cstrError1506Message
' -----------------------> exclude the archives from the collection
byteCounter = 0
For byteCounter = 1 To clctStrFoundMatches.Count
If blnContainsPattern("\.gz$", clctStrFoundMatches(byteCounter).innerText) Then
clctStrFoundMatches.Remove byteCounter
End If
Next byteCounter
' ----------------------> extract the contract ids and find the last contract id
Set clctInternalIDs = New Collection
For Each member In clctStrFoundMatches
clctInternalIDs.Add strReturnSingleMatch("\d{9}", member.innerText)
If clctInternalIDs(clctInternalIDs.Count) = "False" Then Err.Raise 1505, "FileUpload", p_cstrError1505Message
Next member
byteMaxID = FindMaximum(clctInternalIDs)
strPathToXMLFile = clctStrFoundMatches(byteMaxID).innerText
' -----------------------> check whether such file exists, and, if not, download it
If blnFileExists(strPathToXMLFile, p_cstrXMLDestination) Then
Else
strURLToXMLFile = p_cstrWebInterfaceXMLRootDirectory & strPathToXMLFile
Set htmlWebInterfaceXML = Nothing: Set htmlWebInterfaceXML = New MSXML2.XMLHTTP
htmlWebInterfaceXML.Open "GET", strURLToXMLFile, False
htmlWebInterfaceXML.setRequestHeader "Authorization", "Basic" & Base64Encode( _
p_cstrXMLWebInterfaceAuthenticationUser & ":" & p_cstrXMLWebIntervaceAuthenticationPassword)
htmlWebInterfaceXML.send
With domdocXMLText
.validateOnParse = False
.async = False
End With
domdocXMLText.LoadXML htmlWebInterfaceXML.responseText
domdocXMLText.Save p_cstrXMLDestination & "\" & strPathToXMLFile
End If
Next vrntContractID
End If
Set htmlHTMLMainPageXMLInterface = Nothing
End Sub

Answer 1

I had a similar problem that i solved. my script ran through a server and looked for a string in thousands of text files.
The way i solved it is (using ascync ServerXMLHTTP60) setting an if condition in the response handler to ABORT the xmlhttp object. After i was done comparing data, the object would get "dropped" out of memory, and now i can query (virtually) any amount of data. (took me about a month to test a lot of solution, and this was the right one)
This might work for you, so just add htmlWebInterfaceXML.abort after you are done with that data set.
Hope this helps! Cheers!