| |
▼NJ さん、Keinさん、こんばんは。
>下記の作業を前提として、マクロで対応したいと考えております。
>1.Internet Explorerであるサイトを表示します
>（例えば、質問箱の新規投稿フォームなど）
>2.ブラウザ上でテキストフィールドを含めた内容をコピーします。
>3.Excelのシート上に2.をペースト
>（ExcelのシートにHTMLのテキストフィールドオブジェクトが張り付けられます）
>
>3.の状態でマクロを起動し、テキストフィールドに入力されている内容を取得したいのです。
>（認証を経由した先の画面のHTMLを取得したいため、URLを指定してHTMLソースを取得するわけにはいかない状況にあります）
ひょっとしてこれですか？
'=======================================================
Sub testtest()
Dim shp As OLEObject
With ActiveSheet
For Each shp In .OLEObjects
If UCase(TypeName(shp.Object)) = UCase("htmltext") Or UCase(TypeName(shp.Object)) = UCase("htmltextarea") Then
MsgBox shp.Object.Value
End If
Next
End With
End Sub
アクティブシートにHtml貼付けを行った後の処理です。
これは、このサイトの新規投稿画面のテキストを何とか取得できるように
したものです。
確認してください。
他には、こんな方法もいかがですか？
'==============================================================
Sub test()
Dim IE
Dim idoc As Object
Dim idx As Long
Dim obj As Object
Cells.Clear
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate "http://www.vbalab.net/vbaqa/c-board.cgi?cmd=psn;id=excel"
Do While .Busy = True Or .readyState <> 4
Loop
AppActivate Application.Caption
ThisWorkbook.Activate
ans = MsgBox("準備ができたらＯＫを押して", vbOKCancel)
If ans <> 1 Then Exit Sub
Set idoc = .document
On Error Resume Next
With idoc
For Each obj In idoc.all
Err.Clear
tp = obj.Type
If Err.Number = 0 And (tp = "text" Or tp = "textarea") Then
If obj.Value <> "" Then
ThisWorkbook.Worksheets(1).Cells(idx + 1, 1).Value = obj.Value
idx = idx + 1
End If
End If
Next
End With
Set idoc = Nothing
On Error GoTo 0
End With
IE.Quit
Set IE = Nothing
End Sub
このサイトの新規登録画面が表示されますから、
適当に入力して
「送信」する前にExcel側の「ＯＫ」ボタンを押してみてください。
確認してみてください。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
