将网页数据复制并粘贴到记事本中

问题描述:

我需要在IE中复制打开一个XML并在网页中选择内容(Ctrl + A)并复制它们(Ctrl + c)并将它们粘贴到记事本中。下面是代码,但它不起作用。将网页数据复制并粘贴到记事本中

Dim ie As Object 
Dim ieDoc As Object 
Dim Data As String 

Set ie = CreateObject("InternetExplorer.Application") 
ie.navigate "C:\Data\test_10.xml" ie.Visible = True 

Do Until (ie.readyState = 4 And Not ie.Busy) 
    DoEvents 
Loop 

SendKeys "^a", True 
Application.Wait (5) 
SendKeys "^c" 
Dim FileNo As Integer 
FileNo = FreeFile 
Open "C:\Data\Sample.txt" For Output As FileNo 
SendKeys "^v", True 
Close FileNo 
+0

它做什么而不是工作? – 2014-10-17 06:43:07

Open语句不打开一个记事本应用程序,它刚刚在VBA创建输入/输出的文件句柄到一个文件中。您需要创建一个类似于创建IE应用程序对象的记事本应用程序对象。

还考虑一起避免SendKeys。代替

  • 读出从IE对象中的数据转换成一个字符串变量使用InnerHTML属性
  • 使用Open/Write
  • 任选重新打开在文本文件写出来的字符串转换成一个平面文件记事本应用

试试这个:

Sub pExtractXMLData() 

    Dim strURLtoNavigate  As String 
    Dim strHTML     As String 

    strURLtoNavigate = "C:\Data\test_10.xml" 
    strHTML = UsingXmlParser(strURLtoNavigate) 
    Call WriteVarToDisk(strHTML, "C:\Data\Sample.txt") 

End Sub 




Public Function UsingXmlParser(strUrl As String) 

    Dim objxmlhttp As Object 

    Set objxmlhttp = CreateObject("MSXML2.XMLHTTP") 
    objxmlhttp.Open "GET", strUrl, False 
    objxmlhttp.send 
    'objxmlhttp.WaitForResponse 
    UsingXmlParser = objxmlhttp.ResponseText 

    Set objxmlhttp = Nothing 

End Function 

Public Sub WriteVarToDisk(vartowrite, FiletoWrite) 

    On Error Resume Next 
    Dim fso, MyFile 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set MyFile = fso.CreateTextFile(FiletoWrite, True) 
    MyFile.WriteLine (vartowrite) 
    MyFile.Close 

End Sub 

试试这个..你可以在excel中打开记事本。做所有的工作,并保存为记事本..

以下代码将帮助你。

Sub ImportXMLtoList() 
    Dim strTargetFile As String 
    Dim wb as Workbook 
    dim dwb as workbook 

     Application.Screenupdating = False 
     Application.DisplayAlerts = False 
     strTargetFile = "C:\Data\test_10.xml" 
     Set wb = Workbooks.OpenXML(Filename:=strTargetFile,LoadOption:=xlXmlLoadImportToList) 
     Application.DisplayAlerts = True 
     wb.Sheets(1).UsedRange.Copy 
     set dwb = workbooks.open("C:\Data\Sample.txt") 
      dwb.activesheet.range("A1").PasteSpecial xlPasteValues  
      dwb.close true 
     wb.Close False 
     Application.Screenupdating = True 
    End Sub