- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2015-9-25 08:32
| 只看該作者
回復 1# kuhsuanchieh
試試看- Option Explicit
- '頁數
- Const 頁數網址 = "http://www.tyland.org.tw/pg.asp?theme=11&kinds=2&area=&search=o&review=&model=1&meid=&absolutepage="
- '會號 ID
- Const ID = "http://www.tyland.org.tw/view-m.asp?mno="
- Dim Sh As Worksheet, Ie As Object
- Sub Ex()
- Ex現在會員名錄
- Ex_所有會員資料
- End Sub
- Sub Ex現在會員名錄()
- Dim i As Integer, xTable As Object, r As Integer
- Set Ie = CreateObject("InternetExplorer.Application")
- Set Sh = Sheets(1)
- With Sh
- .UsedRange.Clear
- .[A1:E1] = Array("ID", "姓名", "電話", "傳真", "地址")
- '.[A1:D1] = Array( "姓名", "電話", "傳真", "地址")
- .Activate
- End With
- With CreateObject("InternetExplorer.Application")
- ' .Visible = True
- For i = 1 To Max_Page
- .Navigate 頁數網址 & i
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Set xTable = .Document.all.tags("table")(0).Rows
- Application.StatusBar = 頁數網址 & i & " 載入..."
- For r = 1 To xTable.Length - 1
- Ex_現在會員資料 ID & xTable(r).Cells(1).INNERTEXT
- Next
- Next
- .Quit
- End With
- Ie.Quit
- Set Ie = Nothing
- End Sub
- Sub Ex_現在會員資料(URL As String)
- Dim ID As String, i As Integer, E As Variant, ii As Integer, t As Variant, AR()
- ID = "http://www.tyland.org.tw/view-m.asp?mno="
- AR = Array(0, 1, 2, 3, 6) 'AR = Array( 1, 2, 3, 6) 不要"ID"
- With Ie
- ' .Visible = True
- .Navigate URL
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- t = Split(.Document.BODY.INNERTEXT, vbLf) '網頁的文字,vbLf 切割為陣列
- With Sh.Range("A" & Rows.Count).End(xlUp).Offset(1)
- .Select '可不用
- For ii = 0 To 4
- .Cells(1, ii + 1) = Split(t(AR(ii)), "：")(1)
- Next
- End With
-
- End With
- End Sub
- Function Max_Page() As Integer '傳回會員名錄的總頁數
- Dim E As Object
- With CreateObject("InternetExplorer.Application")
- ' .Visible = True
- .Navigate "http://www.tyland.org.tw/pg.asp?theme=11"
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- For Each E In .Document.all.tags("A")
- If InStr(E.INNERTEXT, "最後一頁") Then
- Max_Page = Replace(E.href, 頁數網址, "") '網頁字串最後的數字
- Exit For
- End If
- Next
- .Quit '關閉網頁
- End With
- End Function
- '****************************************************
- Sub Ex_所有會員資料()
- Dim i As Integer, E As Variant, ii As Integer, t As Variant, AR()
- Dim Sh As Worksheet
- Set Sh = Sheets(2)
- With Sh
- .UsedRange.Clear
- .[A1:E1] = Array("ID", "姓名", "電話", "傳真", "地址")
- '.[A1:D1] = Array( "姓名", "電話", "傳真", "地址")
- .Activate
- End With
- AR = Array(0, 1, 2, 3, 6) 'AR = Array( 1, 2, 3, 6) '不要"ID"
- With CreateObject("InternetExplorer.Application")
- ' .Visible = True
- For i = 1 To Max_Id
- .Navigate ID & i
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Application.StatusBar = ID & i & " 載入..."
- t = Split(.Document.BODY.INNERTEXT, vbLf)
- If UBound(t) > -1 Then
- With Sh.Range("A" & Rows.Count).End(xlUp).Offset(1)
- .Select '可不用
- For ii = 0 To 4 'For ii = 0 To 3 '不要"ID
- .Cells(1, ii + 1) = Split(t(AR(ii)), "：")(1)
- Next
- End With
- End If
- Next
- .Quit
- End With
- End Sub
- Function Max_Id() As Integer '查找最新會員的會號
- Dim E As Object
- With CreateObject("InternetExplorer.Application")
- ' .Visible = True
- .Navigate "http://www.tyland.org.tw/pg.asp?theme=11"
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- For Each E In .Document.all.tags("A")
- If InStr(E.INNERTEXT, "最後一頁") Then
- E.Click '按下 "最後一頁"
- Exit For
- End If
- Next
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Set E = .Document.all.tags("table")(0).Rows
- Max_Id = E(E.Length - 1).Cells(1).INNERTEXT '最新會員的會號
- .Quit '關閉網頁
- End With
- End Function
|
|
發表於 2015-9-24 18:48
| 
發表於 2015-9-25 15:45
| 