VBA 用递归法提取多层网站数据

cunfu2010

网址：http://www.stats.gov.cn/tjsj/tjbz/tjyqhdmhcxhfdm/2018/
今天遇到一个提取网站数据的问题，想用递归法提取，但无从下手（提取多层文件夹可以）。求助各位大侠指点。
数据按省、市、县、乡、村五级排列

我是来讨说法的

这个网址很适合新手练习，加油

duquancai

加油                 

EH_LOVE

相对麻烦你这个站

cunfu2010

用数组的方法已经解决，想用递归的方法，但学艺不精，琢磨了几天了，实在想不出来了，发贴救教。让诸位见笑了

YZC51

cunfu2010 发表于 2019-9-29 18:40
用数组的方法已经解决，想用递归的方法，但学艺不精，琢磨了几天了，实在想不出来了，发贴救教。让诸位见笑 ...

求教如何用数组方法解决的？

cunfu2010

YZC51 发表于 2019-9-29 19:35
求教如何用数组方法解决的？

见笑了。下面的代码是提取乡、村两级的。
Sub test()
    Dim arr(), brr()
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = False
        .navigate "http://www.stats.gov.cn/tjsj/tjbz/tjyqhdmhcxhfdm/2018/13/06/130606.html"
        Do Until .readyState = 4
            DoEvents
        Loop

        n = 0
        For Each tr In .Document.body.all.tags("tr")
            If (InStr(1, tr.className, "towntr") > 0 And tr.all.tags("a").Length > 0) Then
                n = n + 1
                ReDim Preserve arr(1 To 2, 1 To n)
                arr(1, n) = tr.all.tags("td")(1).innerText
                arr(2, n) = tr.all.tags("a")(0).href
            End If
        Next

        q = 0
        For i = 1 To n
            .navigate arr(2, i)
            Do Until .readyState = 4
                DoEvents
            Loop
            For Each tr In .Document.body.all.tags("tr")
                If (InStr(1, tr.className, "villagetr") > 0) Then
                    q = q + 1
                    ReDim Preserve brr(1 To 2, 1 To q)
                    brr(1, q) = arr(1, i)
                    brr(2, q) = tr.all.tags("td")(2).innerText
                End If
            Next
        Next
    End With
    Cells(1, 1).Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)
    Columns("A:B").EntireColumn.AutoFit
End Sub

YZC51

cunfu2010 发表于 2019-9-29 20:08
见笑了。下面的代码是提取乡、村两级的。
Sub test()
    Dim arr(), brr()

谢谢老师指教！

cunfu2010

不敢称，我就是一学生，等待真正的老师解疑。

1588078/37

cunfu2010 发表于 2019-9-29 18:40
用数组的方法已经解决，想用递归的方法，但学艺不精，琢磨了几天了，实在想不出来了，发贴救教。让诸位见笑 ...

发下文件看下，