search列的url，将网页保存为单独的文本文件

我有代码在这里工作的硬编码的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中searchURL（可能使用InStr（variables，“http：//”）作为布尔值），然后将每个网页保存为单独的文本文件。 有没有办法使用部分URLstring来命名文本文件？ 另外，有没有办法使网页不能打开，但仍保存为文本文件？ 打开网页浪费了很多时间。

我根据@ MikeD的build议创build了这个额外的子，但是我得到了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 

并删除URL和FileName的Dim和赋值语句

其次，编写另一个Sub，它遍历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对象作为parameter passing给子例程，以便不再次打开/closures浏览器。