1

我这里的代码适用于硬编码的 url，它只适用于一个 url 和一个文本文件。

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 列中搜索 url（可能使用 InStr(variable, "http://") 作为布尔值），然后将每个网页保存为单独的文本文件。有没有办法使用部分 URL 字符串来命名文本文件？另外，有没有办法让网页不打开，但仍保存为文本文件？打开网页会浪费很多时间。

我根据@MikeD 的建议创建了这个额外的子程序，但我得到了 wend 没有 while 错误。

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
4

1 回答 1

0

首先你可以参数化子

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

并删除 and 的andDim赋值语句URLFileName

Secondly you write another Sub which loops through non-empty cells in column B, retrieving values and conditionally calling the saveUrl_param() routine.

example:

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

and no - you can't do it without opening the Web page; you somehow have to get the page from the server (or the proxy). This is done by

ieApp.Navigate URL

and the following While ... Wend construct waits until the page is fully loaded into the browser object.

To speed up things you could skip

ieApp.Visible = True

once you have confidence that your Sub is working correctly, and you could move

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

to the calling sub and hand over the ieApp object to the subroutine as a parameter in order to not open/close the browser again & again.

于 2013-02-26T10:29:48.783 回答