VERSION 5.00
Begin VB.Form frmConvertToExcel 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "HTMLTable to Excel"
   ClientHeight    =   900
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6990
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   900
   ScaleWidth      =   6990
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdConvert 
      Caption         =   "&Convert tables to sheet"
      Height          =   390
      Left            =   4650
      TabIndex        =   2
      Top             =   450
      Width           =   2265
   End
   Begin VB.ComboBox cboAddress 
      Height          =   315
      Left            =   1080
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   75
      Width           =   5865
   End
   Begin VB.Label lblProgress 
      BorderStyle     =   1  'Fixed Single
      Height          =   270
      Left            =   75
      TabIndex        =   3
      Top             =   510
      Width           =   4545
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "&Navigate to:"
      ForeColor       =   &H80000008&
      Height          =   195
      Left            =   105
      TabIndex        =   0
      Top             =   105
      Width           =   870
   End
End
Attribute VB_Name = "frmConvertToExcel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents IE As InternetExplorer
Attribute IE.VB_VarHelpID = -1
Dim EnterFlag As Boolean
Private Sub cboAddress_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    EnterFlag = True
    cboAddress.AddItem cboAddress.Text
    cmdConvert.SetFocus
End If

End Sub


Private Sub cmdGo_Click()

End Sub

Private Sub cmdConvert_Click()
IE.navigate cboAddress.Text
Me.Move 0, 0
End Sub

Private Sub Form_Load()
cboAddress.AddItem "about:blank"
Set IE = New InternetExplorer
With IE
    .navigate cboAddress.Text
    .Visible = True
End With
End Sub


Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If EnterFlag Then
    If (pDisp Is IE) Then
        Dim hdoc As HTMLDocument
        Set hdoc = IE.document
        Dim ff As Integer, Counter As Integer
        ff = FreeFile
        Dim tbl As HTMLTable, tr As HTMLTableRow, td As HTMLTableCell
        Open "c:\Excelfile.csv" For Output As #ff
            For Each tbl In hdoc.All.tags("TABLE")
                For Each tr In tbl.Rows
                    Dim str As String
                    For Each td In tr.Cells
                        If td.innerText <> "" Then
                            str = str & Chr$(34) & td.innerText & Chr$(34) & ","
                        Else
                            str = str & Chr$(34) & " " & Chr$(34) & ","
                        End If
                    Next td
                    Print #ff, str
                    str = ""
                    Counter = Counter + 1
                    lblProgress.Caption = "Reading row: " & Counter
                    lblProgress.Refresh
                Next tr
            Next tbl
        Close #ff
    End If
End If
lblProgress.Caption = "Complete: " & Counter & " rows."
cboAddress.SetFocus
End Sub