[[20140412232156]]　『 IEの選択範囲を取得』（田吾作）　ページの最後に飛ぶ

『 IEの選択範囲を取得』（田吾作）

 こんばんは、よろしくお願いいたします。

 ウィンドウズ:XP(SP3)
 Excel:2002
 ↑のＰＣ環境で下記のマクロを使ってＩＥ(うろ覚えですがIE7だったと思います)の選択範囲のテキストを
 取得していました。

 最近、ウィンドウズXPのマイクロソフトのサポート終了につき以前から所有しておりスタンドアローンで
 使っていたウィンドウズVISTA/Excel2007のパソコンをネットに繋ぎました。

 VISTA機はIEが7だったので、昨日ウィンドウズにSP1、SP2を当ててからIEを9にバージョンアップしました。

 そうしたら、VISTA機のExcel2007で使えていた下記のマクロがWebページによってはエラーが出るように
 なってしまいました。昨日ウィンドウズ(VISTA)にSP1を当てる前まではどのWebページでも使えてました。

 Sub ieget()
  Dim MyShell As Object, MyWindow As Object
  Dim iestr As String
   Set MyShell = CreateObject("Shell.Application")
   For Each MyWindow In MyShell.Windows
    If UCase(Right(MyWindow.FullName, 12)) = "IEXPLORE.EXE" Then
       iestr = MyWindow.Document.Selection.CreateRange.Text
       If iestr <> "" Then
          MsgBox iestr
       Else
          MsgBox ""
       End If
    End If
   Next MyWindow
   Set MyShell = Nothing
 End Sub

 たとえば、↓のページの「商品説明」の内容を選択した状態でマクロ実行してもエラーにならずに文字を
 取得できます。

 http://page15.auctions.yahoo.co.jp/jp/auction/t368567379

 しかし、↓ですと、文字を選択して実行したらエラーになります。

 https://www.excel.studio-kazu.jp/kw/20140411084754.html

 エラー内容は下記の通りです。

 実行時エラー '438':
 オブジェクトは、このプロパティまたはメソッドをサポートしていません。

 ページによってエラーになったりならなかったりする原因は何でしょうか？
 どのように書き換えたら回避できるでしょうか？
 ご指導お願いいたします。

＜使用 Excel：Excel2007、使用 OS：WindowsVista ＞

 補足です。
 エラーになる個所は↓の部分です。

 iestr = MyWindow.Document.Selection.CreateRange.Text

 よろしくお願いいたします。
（田吾作） 2014/04/12(土) 23:39

 とりあえず、API関数を使う方法で取得できるようにはなりました。

 Sub test2()
  Const OLECMDID_COPY = 12&
  Const OLECMDID_SELECTALL = 17&
  Const OLECMDEXECOPT_DODEFAULT = 0&
  Dim CB As New DataObject
  Dim iestr As String
  Dim MyShell As Object, MyWindow As Object
   Set MyShell = CreateObject("Shell.Application")
   For Each MyWindow In MyShell.Windows
    If UCase(Right(MyWindow.FullName, 12)) = "IEXPLORE.EXE" Then
       AppActivate MyWindow
       MyWindow.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
       With CB
        .GetFromClipboard
        iestr = .GetText
        MsgBox iestr
      End With
     Exit For
   End If
  Next
 End Sub

 ただ、この方法はクリップボードを使いますので、最初にご呈示させていただいたコード
 を一部修正していけるのならご教示いただきましたら幸いです。よろしくお願いいたします。
（田吾作） 2014/04/13(日) 11:05

 不格好なコードですが、下記のコードで誤魔化すことにしました。

 '参照設定:Microsoft Forms 2.0 Object Library

 Sub ieget()
  Dim MyShell As Object, MyWindow As Object
  Const OLECMDID_COPY = 12&
  Const OLECMDID_SELECTALL = 17&
  Const OLECMDEXECOPT_DODEFAULT = 0&
  Dim CB As New DataObject
  Dim iestr As String
  Dim cbstr As String
  Dim flg As Boolean
   Set MyShell = CreateObject("Shell.Application")
   For Each MyWindow In MyShell.Windows
    If UCase(Right(MyWindow.FullName, 12)) = "IEXPLORE.EXE" Then
       flg = False
       Err.Clear
       On Error Resume Next
       'IE選択範囲テキスト取得
       iestr = MyWindow.Document.Selection.CreateRange.Text
       'エラー番号438の場合
       If Err.Number = 438 Then
          flg = True
          'クリップボード内容記憶
          With CB
           .GetFromClipboard
           cbstr = .GetText
          End With
          'IEウィンドウアクティブ化
          AppActivate MyWindow
          'IE選択範囲クリップボード格納
          MyWindow.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
          'クリップボード内容取得
          With CB
           .GetFromClipboard
           iestr = .GetText
          End With
       End If
       'エラー番号438の場合
       If flg = True Then
           '記憶しておいたクリップボード内容書き戻し
           With CB
            .SetText cbstr
            .PutInClipboard
          End With
       End If
       On Error GoTo 0
       'エクセルウィンドウアクティブ化
       AppActivate Application.Caption
       'IE選択範囲テキスト表示
       If iestr <> "" Then
          MsgBox iestr
       Else
          MsgBox ""
       End If
    End If
   Next MyWindow
   Set MyShell = Nothing
 End Sub
（田吾作） 2014/04/15(火) 01:16

コメント返信：

[ 一覧(最新更新順) ]

[[20140412232156]] 『 IEの選択範囲を取得』（田吾作） ページの最後に飛ぶ

[[20140412232156]]　『 IEの選択範囲を取得』（田吾作）　ページの最後に飛ぶ