1

ハードコードされた URL に対して機能するコードがここにあります。これは、1 つの URL と 1 つのテキスト ファイルに対してのみ機能します。

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://") をブール値として使用して)、各 Web ページを個別のテキスト ファイルとして保存することです。URL 文字列の一部を使用してテキスト ファイルに名前を付ける方法はありますか? また、Web ページを開かずにテキスト ファイルとして保存する方法はありますか? ウェブページを開くのは、多くの時間を無駄にします。

@MikeD の提案に基づいてこの追加のサブを作成しましたが、while エラーなしで 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
4

1 に答える 1

0

まず、サブをパラメータ化できます

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

Dimand のand 割り当てステートメントを削除しURLますFileName

次に、列 B の空でないセルをループして値を取得し、条件付きでsaveUrl_param()ルーチンを呼び出す別の Sub を作成します。

例：

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

いいえ、Web ページを開かずに実行することはできません。何らかの方法でサーバー (またはプロキシ) からページを取得する必要があります。これは

ieApp.Navigate URL

次のWhile ... Wend構成は、ページがブラウザ オブジェクトに完全に読み込まれるまで待機します。

スキップできるものを高速化するには

ieApp.Visible = True

Sub が正常に動作していることを確認したら、移動できます。

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

呼び出し元のサブに渡し、ieApp オブジェクトをパラメーターとしてサブルーチンに渡して、ブラウザーを何度も開いたり閉じたりしないようにします。

于 2013-02-26T10:29:48.783 に答える