搜索列的網址，將網頁保存爲單獨的文本文件

Question

我的代碼在這裏適用於硬編碼的網址，它只適用於一個網址和一個文本文件。

Sub saveUrl_Test() 

Dim FileName As String 
Dim FSO As Object 
Dim ieApp As Object 
Dim Txt As String 
Dim TxtFile As Object 
Dim URL As String 

    URL = "www.bing.com" 
    FileName = "C:\mallet\bing.com.txt" 

    Set FSO = CreateObject("Scripting.FileSystemObject") 
    Set TxtFile = FSO.OpenTextFile(FileName, 2, True, -1) 

    Set ieApp = CreateObject("InternetExplorer.Application") 
    ieApp.Visible = True 
    ieApp.Navigate URL 

    While ieApp.Busy Or ieApp.ReadyState <> 4 
     DoEvents 
    Wend 

    Txt = ieApp.Document.body.innerText 
    TxtFile.Write Txt 
    TxtFile.Close 

    ieApp.Quit 

    Set ieApp = Nothing 
    Set FSO = Nothing 
End Sub 

我希望它做的是在B列的網址搜索（可能使用InStr函數（變量，「HTTP：//」）作爲一個布爾值），然後保存每個網頁作爲一個單獨的文本文件。有沒有辦法使用部分URL字符串命名文本文件？另外，有沒有辦法讓網頁不能打開，但仍然保存爲文本文件？打開網頁浪費了大量時間。

我基於@ MikeD的建議創建了這個附加子，但是我得到了wend而沒有發生錯誤。

Sub url_Test(URL As String, FileName As String) 

Dim FSO As Object 
Dim ieApp As Object 
Dim Txt As String 
Dim TxtFile As Object 

    Set FSO = CreateObject("Scripting.FileSystemObject") 
    Set TxtFile = FSO.OpenTextFile(FileName, 2, True, -1) 

    Set ieApp = CreateObject("InternetExplorer.Application") 
    ieApp.Visible = True 
    ieApp.Navigate URL 

    While ieApp.Busy Or ieApp.ReadyState <> 4 
     DoEvents 
    Wend 

    Txt = ieApp.Document.body.innerText 
    TxtFile.Write Txt 
    TxtFile.Close 

    ieApp.Quit 

    Set ieApp = Nothing 
    Set FSO = Nothing 
End Sub 

Sub LoopOverB() 
Dim myRow As Long 

    myRow = 10 

    While Cells(myRow, 2).Value <> "" 

     If InStr(1, Cells(myRow, 2).Value, "http:\\", vbTextCompare) Then Call url_Test(Cells(myRow, 2).Value, "C:\mallet\test\" & Cells(myRow, 1).Value & ".txt") 
     myRow = myRow + 1 
    Wend 
End Sub 

Answer 1

首先，你可以參數化子

Sub saveUrl_param(URL as String, FileName as String) 
    .... 
End Sub 

並刪除Dim和賦值語句URL和FileName

其次，你寫的另一個子，其通過非空單元格列B循環，檢索值並有條件地調用saveUrl_param()例程。

例如：

Sub LoopOverB() 
Dim C As Range 
    For Each C In Intersect(ActiveSheet.Columns("B"), ActiveSheet.UsedRange).SpecialCells(xlCellTypeConstants) 
     ' If C = .... Then ' note: URL in [B], filename in [C] 
     '  saveUrl_param(C, C(1,2)) 
     ' End If 
    Next C 
End Sub 

，並沒有 - 你不能做到這一點，而無需打開網頁;你不知何故必須從服務器（或代理）獲取頁面。這是由

ieApp.Navigate URL 

及以下While ... Wend構造等待做，直到頁面完全加載到瀏覽器對象。

爲了加快的東西，你可以跳過

ieApp.Visible = True 

一旦你有你的小組是否正常工作的信心，你可以移動

Dim ieApp As Object ' I would prefer As SHDocVw.InternetExplorer .... don't like late binding 
Set ieApp = CreateObject("InternetExplorer.Application") 

給調用子交工ieApp對象以該子程序作爲參數以便再次打開/關閉瀏覽器&。