VBA - Extracting data from webpage to Excel worksheet

[Bullstrik1]

Hi everyone!

I've been trying, this last few days, to get this code wrking without success.
And so i come here humbly asking for your help.

What i want to do (step-by-step):

1. Enter a website using my log-in and passwrod;
2. Navigate to a webpage, inside the wesite mentioned in step1, in witch there is a html with hyperlinks;


++++++++++ My code to works just fine in the above steps. Below comes my difficulty ++++++++++++

3. Loop throug all the hyperlinks mentioned in step 2 and click on them one-by-one.
4. Once inside a webpage generated by each of those hyperlinks retrive the data from the html tables to a worksheet
5. The end

---------------------------------------------------------------------------------------------------------------------------------

Below is my VBA code. I know its needs to be optimised, specifically when it comes to setting to nothing all the memory consuming variables. I would have done it if i knew how. Pls let me know how can i properly set those variables to nothing while the code keeps roling normaly.
Also, pls let me know if u need any HTML code forom the webpage i'm trying to access via VBA.

Option Explicit

Sub ImportData()

'to refer to the running copy of Internet Explorer
Dim ie As InternetExplorer, Wsht As Worksheet, c As String
'to refer to the HTML document returned
Dim Doc As HTMLDocument, Doc2 As IHTMLDocument, AlertsDoc As HTMLDocument
Dim Alerts As IHTMLElementCollection, TR As IHTMLElementCollection, aTag As IHTMLElementCollection
Dim AlertsT As IHTMLElement, A As IHTMLElement, tdobj As IHTMLElement, aobj As IHTMLElement, td As IHTMLElementCollection


With ActiveWorkbook
    Set Wsht = .Worksheets(1)
End With


With Wsht
    If .Range("E1048576").End(xlUp).Row = 11 Then GoTo Label_Next
    .Range("A12:BB" & .Range("E1048576").End(xlUp).Row).EntireRow.ClearContents
Label_Next:
End With


'open Internet Explorer in memory, and go to website
Set ie = New InternetExplorer




With ie
        .Visible = True ' Podemos optar por nao mostrara janela do browser o que irá permitir acelerar todo o processo. Para tal basta escolher a opção "FALSE"
        .navigate ("https://www.portfoliomanager.dnb.com/V7.2/ContentPages/Logon/SecureLogon.aspx")
        While .Busy Or .readyState <> 4: DoEvents: Wend
            With .document
                ' Código para fazer log in no site Portofolio Manager através do InternetExplorer
                ' Insere País, username e password automativamente e redirecciona o browser para a página "https://www.portfoliomanager.dnb.com/V7.2/Contentpages/PortfolioAnalysis/DigitalDashboard2.aspx"
                .getElementById("ctl00_cphMaster_ddlCountry").Focus
                .getElementById("ctl00_cphMaster_ddlCountry").Value = "Portugal"
                .getElementById("ctl00_cphMaster_txtUserID").Focus
                .getElementById("ctl00_cphMaster_txtUserID").Value = "MAFi1il"
                .getElementById("ctl00_cphMaster_txtPassword").Focus
                .getElementById("ctl00_cphMaster_txtPassword").Value = "Mp00030_rf"
                .getElementById("ctl00_cphMaster_btnLogin").Click
            End With
            
     ' aguarda que a webpage carregue por completo
    Do While .Busy Or ie.readyState <> READYSTATE_COMPLETE
        DoEvents
        Debug.Print
    Loop
    
       ' segue para a página de Alertas
       .navigate ("https://www.portfoliomanager.dnb.com/V7.2/Contentpages/PortfolioAnalysis/AlertResults.aspx")
    While .Busy Or .readyState <> 4: DoEvents: Wend
    
    Set Doc = ie.document
    
        'Selecciona a tabela com os links para a informação de interesse e percorr todas as linhas até encontrar hyperlinks
        'Prime cada um dos hyperlinks e extrai informação
        
    With Doc
        '   Define a tabela em html sobre a qual pretendemos procurar os hyperliks a clicar
        Set AlertsT = .getElementById("ctl00_cphMaster_divCollapsibleAlertResultsByAlert")
        '   Define elementos associados à tabela
        Set Alerts = AlertsT.Children
        '   Define a colecção de "table rows" da tabela html
        Set TR = AlertsT.getElementsByTagName("tr")
                
        'Loop que permite percorrer cada linha de tabela
        For Each A In TR
            Set td = A.getElementsByTagName("td")
                'Loop que permite obter cada objecto nos elementos "Table data" da tabela em html
                For Each tdobj In td
                    Set aTag = tdobj.getElementsByTagName("a")
                        'Loop que permite focar cada objecto nos elementos table data e clicar no hyperlink
                        For Each aobj In aTag
                                c = aobj.innerHTML
                            aobj.Click
                                ' Define a nova pagina web gerada pelo click no Hyperlink
                                Set Doc2 = ie.document
                                    '   Define a tabela em html que pretendemos copiar para o Excel
                                With Doc2
                                    Dim tbl As HTMLTable, tr0 As HTMLTableRow, insertRow As Long, Row As Long, col As Long
                                     On Error Resume Next
                                    Set tbl = .getElementById("ctl00_cphMaster_dgrdCustomers")
                                        
                                        With Wsht
                                            insertRow = .Range("E1048576").End(xlUp).Row
                                            ' Percorre cada linha da tabela e copia-a para a worksheet(1) do presente workbook
                                            For Row = 0 To tbl.Rows.Length - 1
                                                Set tr0 = tbl.Rows(Row)
                                                If Trim(tr0.innerText) <> "D-U-N-SCou.Business NameOut of BusinessPrevious Current% ChangeOutstandingAlert DateAccounts" Then
                                                     If tr0.Cells.Length > 2 Then
                                                        If tr0.Cells(1).innerText <> "Total" Then
                                                            insertRow = insertRow + 1
                                                                For col = 1 To tr0.Cells.Length - 1
                                                                    .Cells(insertRow, col + 1) = tr0.Cells(col).innerText
                                                                Next
                                                        End If
                                                    End If
                                                End If
                                            Next
                                            If c = "Alteração Negativa Limite de Crédito D&B" Then c = "Alteração Negativa Limite de Crédito D&B"
                                            .Range("A12:A" & .Range("E1048576").End(xlUp).Row) = c
                                        End With
                                        ie.GoBack
                                End With
                                Set Doc2 = Nothing
Label_Nextaobj:
                        Next aobj
                Next tdobj
        Next A
    End With


End With
'close down IE and reset status bar
'Set ie = Nothing
'    ie.Quit
'Application.StatusBar = ""
End Sub

Hope someone can help me!
Cheers

 

[Bullstrik1]

I solved my issue with this code by deleting it lol
If any moderator could delete this post i would apretiate it.

Cheers!