0

I have been a long time lurker on this site and I appreciate everything that I have learned from each of your responses that I have seen. Now I am looking to efficiently run through a code that I have written with your help.

Problem 1- Page shows as 'not responding' while running the code. This happens about 4 times every time it is ran. Also, I am getting the data in about 1 minute and 40 seconds. My company doesn't have the best internet so that may be why it takes so long.

Problem 2- Is there a better methodology of running through a loop, to where the code is on a singular macro, rather than in 10 separate macros. My site only changes a four letter portion within the URL(shown as DYNAMICPORTION in the 2nd code below. I have tried to loop it with a URL that refers to a range, but cant figure out how to have it place this information on a new worksheet within the loop.

Any help would be appreciated! Thanks again!

Main Macro

Sub GetAllData()

Dim t As Date
t = Now()

Application.Calculation = xlManual

    Application.StatusBar = "Gathering Data 10%"
GetSiteData
    Application.StatusBar = "Gathering Data 20%"
GetSite2Data
    Application.StatusBar = "Gathering Data 30%"
GetSite3Data
    Application.StatusBar = "Gathering Data 40%"
GetSite4Data
    Application.StatusBar = "Gathering Data 50%"
GetSite5Data
    Application.StatusBar = "Gathering Data 60%"
GetSite6Data
    Application.StatusBar = "Gathering Data 70%"
GetSite7Data
    Application.StatusBar = "Gathering Data 80%"
GetSite8Data
    Application.StatusBar = "Gathering Data 90%"
GetSite9Data
    Application.StatusBar = "Gathering Data 100%"
GetSite10Data

    Application.Calculation = xlAutomatic
    Application.StatusBar = Ready
    
MsgBox "It took " & Format(Now() - t, "hh:mm:ss") & " to gather the site's data!" & vbNewLine & "Please allow a minute to calculate!"

End Sub

Macro under the main

Sub GetSiteData()
Dim XMLRequest As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLTable As MSHTML.IHTMLElement
Dim HTMLTable2 As MSHTML.IHTMLElement
Dim TableRow As MSHTML.IHTMLElement
Dim TableCell As MSHTML.IHTMLElement
Dim RowNum As Long, ColNum As Long
Dim url As String: url = "https://thewebsite/theproduct/isextracted/index.cfm?site=DYNAMICPORTION&type=data"
Dim OutputSheet As Worksheet

Set OutputSheet = ThisWorkbook.Worksheets("Site")
OutputSheet.Cells.ClearContents

XMLRequest.Open "GET", url, False
XMLRequest.send
Do While XMLRequest.readyState <> 4
    DoEvents
Loop
HTMLDoc.body.innerHTML = XMLRequest.responseText

Set HTMLTable = HTMLDoc.getElementById("TAB7")
Set HTMLTable2 = HTMLDoc.getElementById("TAB5")

RowNum = 0
ColNum = 0

    For Each TableRow In HTMLTable.getElementsByTagName("tr")
        RowNum = RowNum + 1
        For Each TableCell In TableRow.Children
            ColNum = ColNum + 1
            OutputSheet.Cells(RowNum, ColNum).Value = TableCell.innerText
        Next TableCell
        ColNum = 0
    Next TableRow

    For Each TableRow In HTMLTable2.getElementsByTagName("tr")
        RowNum = RowNum + 1
        For Each TableCell In TableRow.Children
            ColNum = ColNum + 1
            OutputSheet.Cells(RowNum, ColNum).Value = TableCell.innerText
        Next TableCell
        ColNum = 0
    Next TableRow

End Sub
  • Not sure with ,False setting that readystate does anything. Your code will be quicker if you empty into an array and write that array out in one go to the sheet. You don't have control of the server, likely limited control over internet so your code is the easiest target. When timing where did you find the slow point to be? In the request itself? – QHarr Oct 04 '20 at 18:20
  • @QHarr I see what you are saying. I added in the readystate to see if it was trying to move on prior to letting the page load. I really don't think it did anything. We do have very limited internet, and this site requires a security certificate to access. This code also gets stuck in a loop if I do not open a hyperlink to the page from excel. It appears 'not responsive' while looping through the 'GetAllData' sub. It will freeze and then resume, over and over. It is still working while its in the 'not responsive' state though! – Zoopatrol16 Oct 04 '20 at 18:39
  • So you need to open a browser connection with certificate in order for your xhr to go through? – QHarr Oct 04 '20 at 18:43
  • @QHarr on this script yes. I do not quite understand it either. I have another sub that is scraping the images off the same site, with the same XHR coding layout, and it does not require me to pull up a browser from excel prior to running it. The page I am loading in the macro above, is going to a backend page that is referenced within the pages above it about 4 times. Once I get to the page with the actual TR/TD data I want, it has about 200k+ HTML lines and takes a bit longer to load compared to the front pages of the site itself. – Zoopatrol16 Oct 04 '20 at 18:47
  • Did you try serverxmlhttp with the certificate e.g. https://stackoverflow.com/questions/9212985/cant-use-https-with-serverxmlhttp-object ? – QHarr Oct 04 '20 at 18:54
  • @QHarr I ran into information on ServerXMLHTTP a week or so ago. I am not too familiar with it. We have little-to-no admin rights on our computers. I am using a Common Access Card for my certificates though. I just read through what you referenced to, and I cannot access my credentials in the manner explained. I use the CAC to access .mil sites, which is the site that I am accessing with the macro above. It does not make sense to me as to why this code would have issues, while the code that grabs images from the same site, has none. I am thinking the code is getting snagged on something. – Zoopatrol16 Oct 04 '20 at 19:30
  • @QHarr would you know how I could loop the 2nd macro above? The URL is dynamic in the '=site' portion, and I am putting each site on its own hidden sheet to further reference what I need. Is there a way to have 1 macro, that loops and posts the information I want for each URL, and each sheet? Currently I have 15 modules on this workbook and am trying to cut out the pointless sections, as I feel like that would help the workbook overall when it comes to performance. – Zoopatrol16 Oct 04 '20 at 19:43
  • Yes use a loop from 0 to 14 and inside the loop concatenate the required url ending. The dynamic portions can be stored in a Dim (14) string array and you simply index into that with current loop position to retrieve required url ending. Then call the sub within the loop. Create the xmlhttp object outside the loop and pass as an argument to the sub you call, rather than keep creating it. Inside the loop create the new sheet you want to write to and hold it in a variable so you can assign values to that sheet, – QHarr Oct 04 '20 at 20:02
  • Would you mind sending me an example of this with the code I have written above? I am still fairly new to VBA, so I have not dealt with arguments or calls. If not, that's fine! I appreciate your help thus far! I understand that on this site we must do our research and not ask for the easy way out! – Zoopatrol16 Oct 04 '20 at 20:22
  • Something like this: https://pastebin.com/URBmqrih – QHarr Oct 04 '20 at 20:43
  • I will check it out when I get home! Gotta love internet restrictions! – Zoopatrol16 Oct 04 '20 at 20:51
  • No worries. Any questions please let me know. It is useful to add to your question what you have tried and what happened as well as restrict to one problem per post. – QHarr Oct 04 '20 at 20:54

0 Answers0