用于将网页内容复制到 word/excel 工作表的 Vb 脚本或 VBA 代码 [重复]答案

【问题标题】：Vb Script or VBA code to copy the contents of a web webpage to a word/excel sheet [duplicate]用于将网页内容复制到 word/excel 工作表的 Vb 脚本或 VBA 代码 [重复]
【发布时间】：2012-07-31 14:17:54
【问题描述】：

可能重复：
Extract values from HTML TD and Tr

我需要使用 VBA 或 VB 脚本将网页的内容复制到 word/excel 表中（如果使用任何编程语言很忙）..

因此，如果我给出网页的路径，那么系统需要复制网页的内容并将其写入 Word 或 excel 文件中。

【问题讨论】：

标签： vba vbscript copy webpage

【解决方案1】：

下次请贴出你已经拥有的，我有2个解决方案，选择最适合你需要的，这里按要求使用单词的那个

Option Explicit
'Just change these two lines
Const HTMLFileIn="http://stackoverflow.com/questions/10782976/disable-error-in-vbs"
Const DocFileOut="c:\newfile.doc"

Dim MyWord,oIE
set MyWord=CreateObject("Word.Document") 
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Navigate HTMLFileIn
Wscript.Sleep 500
oIE.document.body.createTextRange.execCommand("Copy")
Wscript.Sleep 500
MyWord.Content.Paste
MyWord.SaveAs DocFileOut
MyWord.Close
oIE.Quit
Set oIE = Nothing
set MyWord = Nothing 
Wscript.Echo HTMLFileIn & " is now saved as " & DocFileOut

Sub wait
  Wscript.Sleep 500
  While oIE.busy
    Wscript.Sleep 1000
  Wend
  While oIE.Document.readyState <> "complete"
    Wscript.Sleep 1000
  Wend
End Sub

如果你只想查看html，这里是最简单的解决方案

url = "http://stackoverflow.com/questions/10782976/disable-error-in-vbs"
set xml = createobject("msxml2.serverxmlhttp.6.0")
with xml
  .open "get", url, false
  .send
  wscript.echo .responsetext
end with

【讨论】：

【解决方案2】：

请参阅我使用单词的其他答案。这里还有另一种技术和另存为 HTML

function download(sFileURL, sLocation, async)
  set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
  objXMLHTTP.open "GET", sFileURL, async
  on error resume next
  objXMLHTTP.send()
  if err.number = 0 then
    do until objXMLHTTP.Status = 200
      wscript.echo objXMLHTTP.Status
      wcript.sleep(200)
    loop
    if objXMLHTTP.Status = 200 Then
      set objADOStream = CreateObject("ADODB.Stream")
      objADOStream.Open
      objADOStream.Type = 1
      objADOStream.Write objXMLHTTP.ResponseBody
      objADOStream.Position = 0    
      set objFSO = Createobject("Scripting.FileSystemObject")
      If objFSO.Fileexists(sLocation) Then objFSO.DeleteFile sLocation
      Set objFSO = Nothing
      objADOStream.SaveToFile sLocation
      objADOStream.Close
      set objADOStream = Nothing
      download = true
    end if
  else
    download = false
  end if
  set objXMLHTTP = Nothing
end function

if download("http://stackoverflow.com/questions/10782976/disable-error-in-vbs", "question.html", false) then
  wscript.echo "download ok"
else
  wscript.echo "download nok"
end if

【讨论】：