Hi sirs
I want to get get html table vale to excel form this website, but i can't get it, And i ask chatgpt it suggest code like list, but still can't get value! Is this website defen or my office version too old not support or neet to plug in vba module? my office is 2010 version, please help & thanks
website: 台泥 (1101) 除權除息 財報分析
website refer pic: https://ibb.co/q1thnqq
code (chatgpt) :
Sub ImportDataFromWebsite_1()
Dim URL As String
Dim HTTPRequest As Object
Dim HTMLDoc As Object
Dim TableElement As Object
Dim TableRow As Object
Dim TableColumn As Object
Dim RowIndex As Integer
Dim ColumnIndex As Integer
Workbooks.Add
'Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\stock\analysis\test.xlsx"
Windows("test.xlsx").Activate
ActiveSheet.Name = "Sheet1"
'ActiveWorkbook.Save '(vb = No)
' Specify the URL of the webpage containing the table
URL = "台泥 (1101) 除權除息 財報分析"
' Create a new instance of the XML HTTP Request object
Set HTTPRequest = CreateObject("MSXML2.XMLHTTP")
' Open the HTTP request and send it
HTTPRequest.Open "GET", URL, False
HTTPRequest.send
' Check if the request was successful (status code 200)
If HTTPRequest.Status = 200 Then
' Create a new HTML document object
Set HTMLDoc = CreateObject("HTMLFile")
' Load the response text into the HTML document
HTMLDoc.body.innerHTML = HTTPRequest.responseText
' Find the table element by looping through all tables
For Each TableElement In HTMLDoc.getElementsByTagName("table")
If TableElement.className = "tb-stock text-center tbBasic" Then
RowIndex = 1
' Loop through each row in the table
For Each TableRow In TableElement.getElementsByTagName("tr")
ColumnIndex = 1
' Loop through each cell in the row
For Each TableColumn In TableRow.getElementsByTagName("td")
' Write the cell value to Excel
ThisWorkbook.Sheets("Sheet1").Cells(RowIndex, ColumnIndex).Value = TableColumn.innerText
ColumnIndex = ColumnIndex + 1
Next TableColumn
RowIndex = RowIndex + 1
Next TableRow
Exit For ' Exit loop once table is found
End If
Next TableElement
If TableElement Is Nothing Then
MsgBox "Table not found!"
End If
Else
MsgBox "Failed to retrieve data from the website!"
End If
' Clean up objects
Set HTTPRequest = Nothing
Set HTMLDoc = Nothing
End Sub
I want to get get html table vale to excel form this website, but i can't get it, And i ask chatgpt it suggest code like list, but still can't get value! Is this website defen or my office version too old not support or neet to plug in vba module? my office is 2010 version, please help & thanks
website: 台泥 (1101) 除權除息 財報分析
website refer pic: https://ibb.co/q1thnqq
code (chatgpt) :
Sub ImportDataFromWebsite_1()
Dim URL As String
Dim HTTPRequest As Object
Dim HTMLDoc As Object
Dim TableElement As Object
Dim TableRow As Object
Dim TableColumn As Object
Dim RowIndex As Integer
Dim ColumnIndex As Integer
Workbooks.Add
'Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\stock\analysis\test.xlsx"
Windows("test.xlsx").Activate
ActiveSheet.Name = "Sheet1"
'ActiveWorkbook.Save '(vb = No)
' Specify the URL of the webpage containing the table
URL = "台泥 (1101) 除權除息 財報分析"
' Create a new instance of the XML HTTP Request object
Set HTTPRequest = CreateObject("MSXML2.XMLHTTP")
' Open the HTTP request and send it
HTTPRequest.Open "GET", URL, False
HTTPRequest.send
' Check if the request was successful (status code 200)
If HTTPRequest.Status = 200 Then
' Create a new HTML document object
Set HTMLDoc = CreateObject("HTMLFile")
' Load the response text into the HTML document
HTMLDoc.body.innerHTML = HTTPRequest.responseText
' Find the table element by looping through all tables
For Each TableElement In HTMLDoc.getElementsByTagName("table")
If TableElement.className = "tb-stock text-center tbBasic" Then
RowIndex = 1
' Loop through each row in the table
For Each TableRow In TableElement.getElementsByTagName("tr")
ColumnIndex = 1
' Loop through each cell in the row
For Each TableColumn In TableRow.getElementsByTagName("td")
' Write the cell value to Excel
ThisWorkbook.Sheets("Sheet1").Cells(RowIndex, ColumnIndex).Value = TableColumn.innerText
ColumnIndex = ColumnIndex + 1
Next TableColumn
RowIndex = RowIndex + 1
Next TableRow
Exit For ' Exit loop once table is found
End If
Next TableElement
If TableElement Is Nothing Then
MsgBox "Table not found!"
End If
Else
MsgBox "Failed to retrieve data from the website!"
End If
' Clean up objects
Set HTTPRequest = Nothing
Set HTMLDoc = Nothing
End Sub