samedi 22 avril 2017

Excel VBA to fetch Xero report

This code works, but not consistently. Often it fails on this line:

For Each objElement In htmlDoc.GetElementsByTagName("td")

Here is the code:

    Dim AppIE
Dim htmlDoc
Dim nRow As Integer
Dim nColNum As Integer
Dim objElement
Dim nColCount As Integer
Set AppIE = CreateObject("InternetExplorer.Application")
AppIE.Visible = True 'login may be required
AppIE.Navigate myString 'from clipboard
While AppIE.Busy 'wait for IE to open
    DoEvents
Wend
While AppIE.ReadyState <> 4 'wait for login
    DoEvents
Wend
While AppIE.Busy 'pause put in by Donald
    DoEvents
Wend
Set htmlDoc = AppIE.Document
nRow = 0
nColCount = 0
nColNum = 0
For Each objElement In htmlDoc.GetElementsByTagName("td")
    'If IsNull(objElement.classname) And IsNull(objElement.innertext) Then
    'Else
        If objElement.classname = "RowHeader2 MenuLeft" Then
            nColCount = nColCount + 1
            Cells(nRow, nColCount).Value = objElement.innertext
        Else
            If nColCount >= 1 Then
                nColNum = nColNum + 1
                Cells(nRow, nColNum).Value = objElement.innertext
                If nColNum = nColCount Then
                    nColNum = 0
                    nRow = nRow + 1
                End If
                If Len(objElement.classname) = 0 Then
                    nColNum = 0
                    nRow = nRow + 1
                End If
            Else
                nRow = nRow + 1
                Cells(nRow, 1).Value = objElement.innertext
            End If
        End If
    'End If
Next
AppIE.Visible = False
MsgBox "Done"
AppIE.Quit
Set AppIE = Nothing




Aucun commentaire:

Enregistrer un commentaire