提前網頁信息，用到儅前瀏覽器

'Option Explicit

Public Const lngStartRow As Long = 2 '起始輸入行

Dim n As Long

Dim objDic As Object

Dim strRef As String, objIE As Object

Dim IsOpen As Boolean

Dim objframe As Object

Sub 網頁元素分析()

    URL = "https://search.douban.com/movie/subject_search?search_text=tt0770442&cat=1002" '測試

    Set objIE = FindWin(URL) '先查找該網頁是否已打開

    If objIE Is Nothing Then

        Set objIE = CreateObject("internetexplorer.application")

        With objIE

            .Visible = False

            .Navigate URL '打開網頁

            Do While .ReadyState <> 4 Or .Busy

                DoEvents

            Loop

        End With

    Else

        IsOpen = True

    End If

    'Application.ScreenUpdating = False

    Set objDic = CreateObject("scripting.dictionary")

    DoEvents

    Call FindFrame(objIE.Document.Frames, ".Document.") '尋找每個frame的內容

    DoEvents

    Cells.WrapText = False '單元格取消自動換行

    Application.ScreenUpdating = True

    Set objDic = Nothing

    Set objIE = Nothing

    MsgBox "完畢！"

End Sub

Sub FindFrame(ByVal objframe As Object, ByVal CellName As String)

    '遞歸查找frame

    Dim i As Long

    DoEvents

    Call OutPutAllCell(objframe, CellName) '輸出元素內容

    For i = 0 To objframe.Length - 1

        objDic.RemoveAll

        Call FindFrame(objframe(i), CellName & "frames(" & i & ").Document.")

    Next

End Sub

Sub OutPutAllCell(ByVal objframe As Object, ByVal CellName As String)

    '輸出元素屬性

    Dim subitem As Object

    Dim strCode As String

    Dim strID As String

    Dim j As Integer

    Dim 元素代碼(), 長度(), 標識(), 名字(), 標識名(), type值(), 值(), href(), 內部數據()

    On Error Resume Next

    n = 0

    For Each subitem In objframe.Document.all

        n = n 1

        objDic(subitem.tagName) = objDic(subitem.tagName) 1

        strCode = "(" & subitem.tagName & ")" & "(" & objDic(subitem.tagName) - 1 & ")"

        strID = subitem.ID

        If strID = "" Then strID = subitem.Name

        ThisWorkbook.Sheets("Sheet1").Cells(n 2, 1).Value = strCode '將數據放入第一個表格檢測

        ThisWorkbook.Sheets("Sheet1").Cells(n 2, 2).Value = subitem.all.Length

        For j = 3 To ThisWorkbook.Sheets("Sheet1").Cells(2, Columns.Count).End(xlToLeft).Column

            ThisWorkbook.Sheets("Sheet1").Cells(n 2, j).Value = CallByName(subitem, ThisWorkbook.Sheets("Sheet1").Cells(2, j).Value, VbGet)

        Next

    Next

    Set subitem = Nothing

End Sub

Function FindWin(ByVal strRef As String) As Object

    '找尋已打開的網頁

    Dim objWin As Object

    For Each objWin In CreateObject("Shell.Application").Windows

        Do While objWin.ReadyState <> 4 Or objWin.Busy

            DoEvents

        Loop

        If LCase(TypeName(objWin.Document)) = "htmldocument" Then

            If objWin.LocationURL = strRef Then

                Set FindWin = objWin

                Exit For

            End If

        End If

    Next

    Set objWin = Nothing

End Function