查看完整版本: Excel VBA 撰寫 : 網頁小說多頁讀取
頁: [1]

MarryHenry 發表於 2019-11-10 12:51 PM

Excel VBA 撰寫 : 網頁小說多頁讀取

平日喜歡看 eyny 長篇小說消磨時間 ,
但又不想一直開著網路在 Web 上看 ,
Web 上也不方便調整習慣的字型字體 ,
所以用 Excel VBA 寫了個小程式 ,
一次讀取多頁 Web 文章 , 再 Copy 到自己偏好的 記事本 , WordPad , Word , ...
調整好字型字體 , 慢慢欣賞

code

Sub 按鈕1_Click()
    網頁讀取
End Sub
Sub 網頁讀取()
    Application.DisplayAlerts = False
    shN = ActiveSheet.Name
    Rows("3:60000").ClearContents
    Range("A3").Select

    sh1 = Val(Cells(2, 3))
    sh2 = Val(Cells(2, 4))

    For sh = sh1 To sh2
        str31 = CStr(Cells(1, 7)) & sh & CStr(Cells(2, 7))

        Set ie = CreateObject("internetexplorer.application")     ' 使用此方式可以免除 "設定引用項目"
        With ie
            .Visible = False                                      ' True 為開啟 ie, False 為不開啟 ie
            .Navigate str31
             Do While .ReadyState <> 4                            ' 等待網頁開啟
                DoEvents
             Loop
            .ExecWB 17, 2                                         ' Select All
            .ExecWB 12, 2                                         ' Copy selection

             Sheets(shN).Select
             ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
            
             ActiveCell.SpecialCells(xlLastCell).Select
             str32 = Selection.Address
             h1 = InStr(2, str32, "$")
             L2 = Right$(str32, Len(str32) - h1)
             Cells(L2 + 2, 2) = sh
             str33 = "A" & L2 + 2
             Range(str33).Select
        End With
        ie.Quit

    Next sh
    Application.DisplayAlerts = True
    MsgBox ("~~~ ok ~~~")
    str30 = "B3:B" & L2 + 2
    Range(str30).Copy
End Sub

/code...<div class='locked'><em>瀏覽完整內容,請先 <a href='member.php?mod=register'>註冊</a> 或 <a href='javascript:;' onclick="lsSubmit()">登入會員</a></em></div><div></div>

MarryHenry 發表於 2019-11-10 12:58 PM

呵呵 , 不好意思 ,
還不會使用如何將程式碼用包住 ,

Jeepluo 發表於 2019-12-6 04:07 PM

你也太神了,給你個讚,佩服你用vba寫

MarryHenry 發表於 2020-3-1 08:30 AM

Jeepluo 發表於 2019-12-6 04:07 PM static/image/common/back.gif
你也太神了,給你個讚,佩服你用vba寫

謝謝您的回覆
VBA 是我的興趣

zaq12345 發表於 2020-4-5 09:20 PM

謝謝大大的分享..大大辛苦了<br><br><br><br><br><div></div>

lexus0518 發表於 2020-4-15 11:37 AM

太強大了,這是上班族的隱藏版福利。{:45:}

erick883 發表於 2022-4-2 04:05 PM

超棒的~~~~~
頁: [1]