HPのtextデータをEXCELにコピーしたい

質問

HPをまるごとコピーしてEXCELのシートに貼り付けるマクロを作りました。

objIE.ExecWB 17, 0
objIE.ExecWB 12, 0
objIE.Quit

Worksheets("Sheet1").Select
Range("A5:A5500").Clear
Range("A5").Select
Application.Wait Now() + TimeValue("00:00:05")
ActiveSheet.Paste

Set objIE = Nothing

ですがこれだとハイパーリンクなどもコピーしてしまい使いづらいのでtextデータだけをコピーしたいと思います。

objIE.Document.Body.InnerText

ググってみた結果、これを使うとできそうな気がするのですがここから先がわかりません。
よろしくお願いします。

回答No.1

n_na_tto · ベストアンサー

●
objIE.ExecWB 17, 0
objIE.ExecWB 12, 0
は全選択してコピーしているだけなので、
クリップボードの中のテキストだけを
PasteSpecialするだけです。

myURL = "http://oshiete1.goo.ne.jp/qa4607197.html?ans_count_asc=20"
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
　.Visible = True
　.Navigate myURL
　Do While .Busy
　Loop
　Do Until .ReadyState = 4 'READYSTATE_COMPLETE
　Loop
　.ExecWB 17, 0 'OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
　.ExecWB 12, 0 'OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
End With
objIE.Quit
Set objIE = Nothing
With Worksheets("Sheet1")
　.Range("A5:A5500").Clear
　.Range("A5").Select
　.PasteSpecial Format:="テキスト"
End With

●どうしても.Document.Body.InnerTextを使うなら、
DataObjectを使ってクリップボードに入れる方法も
あるかもしれません。
Microsoft Forms 2.0 Object Libraryに参照設定が
必要です。
ついでに下のようにほかの2つも参照設定しておけば、
コードを書くときに楽ですよね。
上の17,0の意味もわかりやすくなると思います。

'Microsoft Internet Controlsに参照設定
'Microsoft HTML Object Libraryに参照設定
'Microsoft Forms 2.0 Object Libraryに参照設定
Dim objIE As InternetExplorer
Dim myDoc As MSHTML.HTMLDocument
Dim myData As DataObject
myURL = "http://oshiete1.goo.ne.jp/qa4607197.html?ans_count_asc=20"
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
　.Visible = True
　.Navigate myURL
　Do While .Busy
　Loop
　Do Until .ReadyState = 4 'READYSTATE_COMPLETE
　Loop
　Set myDoc = .document
End With
myStr = myDoc.body.innerText
objIE.Quit
Set myDoc = Nothing
Set objIE = Nothing
Set myData = New DataObject
With myData
　.SetText myStr
　.PutInClipboard
End With
With Worksheets("Sheet1")
　.Range("A5:A5500").Clear
　.Range("A5").PasteSpecial
End With
Set myData = Nothing

お礼

回答を参考にググってみたら解決しました。
ありがとうございました。

回答No.4

marbin

HPにもよりますが、
WEBクエリでもページ全体を取得できます。

回答No.3

marbin

#2です。
>objIE.ExecWB 17, 0
>objIE.ExecWB 12, 0

を使うと、私のコードは↓のようにしてもいけます。

'参照設定：Microsoft Forms 2.0 Object Library

Sub test()
Dim MyShell As Object, MyWindow As Object
Dim CB As New DataObject
Dim mystr As String
Dim sp As Variant
Dim i As Integer
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
Set MyShell = CreateObject("Shell.Application")
For Each MyWindow In MyShell.Windows
If UCase(Right(MyWindow.FullName, 12)) = "IEXPLORE.EXE" Then
MyWindow.ExecWB 17, 0
MyWindow.ExecWB 12, 0
With CB
.GetFromClipboard
mystr = .GetText
End With
sp = Split(mystr, vbCrLf)
For i = 0 To UBound(sp)
With ws.Cells(i + 1, 1)
.NumberFormatLocal = "@"
.Value = sp(i)
End With
Next i
If ws.Cells(1, 1).Value <> "" Then Exit For
End If
Next
Set ws = Nothing
Set wb = Nothing
End Sub

回答No.2

marbin

IE全選択はコードに含めていません。
IEで選択している範囲をシートに転記します。

Sub test()
Dim MyShell As Object, MyWindow As Object
Dim mystr As String
Dim sp As Variant
Dim i As Integer
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
Set MyShell = CreateObject("Shell.Application")
For Each MyWindow In MyShell.Windows
If UCase(Right(MyWindow.FullName, 12)) = "IEXPLORE.EXE" Then
mystr = MyWindow.Document.Selection.CreateRange.Text
sp = Split(mystr, vbCrLf)
For i = 0 To UBound(sp)
With ws.Cells(i + 1, 1)
.NumberFormatLocal = "@"
.Value = sp(i)
End With
Next i
If ws.Cells(1, 1).Value <> "" Then Exit For
End If
Next
Set ws = Nothing
Set wb = Nothing
End Sub

お礼

回答を参考にググってみたら解決しました。
ありがとうございました。