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





Reply With Quote