將網頁數據複製並粘貼到記事本中

Question

我需要在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 

Answer 1

的Open語句不打開一個記事本應用程序，它剛剛在VBA創建輸入/輸出的文件句柄到一個文件中。您需要創建一個類似於創建IE應用程序對象的記事本應用程序對象。

還考慮一起避免SendKeys。代替

• 讀出從IE對象中的數據轉換成一個字符串變量使用InnerHTML屬性
• 使用Open/Write
• 任選重新打開在文本文件寫出來的字符串轉換成一個平面文件記事本應用

Answer 2

試試這個：

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 

Answer 3

試試這個..你可以在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