Office 2007/2010・リボンのカスタマイズ 初心者備忘録

カスタム検索
Office関連

InternetExplorer関連のTips(Office VBA)

ここではInternetExplorerやHTMLDocument関連のTipsを紹介します。

 

 

ブラウザ周りの情報を取得する

userAgent等ブラウザ周りの情報を取得します。
cpuClass」や「platform」で動作環境(32ビット/64ビット)を判別することもできます。

Public Sub Sample()
  With CreateObject("htmlfile")
    With .parentWindow.clientInformation
      Debug.Print "appCodeName:", .appCodeName
      Debug.Print "appMinorVersion:", .appMinorVersion
      Debug.Print "appName:", .appName
      Debug.Print "appVersion:", .appVersion
      Debug.Print "browserLanguage:", .browserLanguage
      Debug.Print "cookieEnabled:", .cookieEnabled '警告ダイアログが表示される
      Debug.Print "cpuClass:", .cpuClass
      Debug.Print "onLine:", .onLine
      Debug.Print "platform:", .platform
      Debug.Print "systemLanguage:", .systemLanguage
      Debug.Print "userAgent:", .userAgent
      Debug.Print "userLanguage:", .userLanguage
    End With
  End With
End Sub

 

InternetExplorerのイベントを取得する

InternetExplorerのイベントを取得します。
Microsoft HTML Object Library」「Microsoft Internet Controls」要参照。

'※ ThisWorkbook に記述
Private WithEvents IE As SHDocVw.InternetExplorer
Private WithEvents Doc As MSHTML.HTMLDocument

Public Sub Sample()
  If Not IE Is Nothing Then Set IE = Nothing
  If Not Doc Is Nothing Then Set Doc = Nothing
  Set IE = New SHDocVw.InternetExplorer
  IE.Visible = True
  IE.navigate "about:blank"
End Sub

Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
  MsgBox "DocumentComplete", vbInformation + vbSystemModal
  Set Doc = IE.document
End Sub

Private Function Doc_onclick() As Boolean
  MsgBox "HTMLDocumentをクリックしました。", vbInformation + vbSystemModal
End Function

 

[input type="file"]を操作する

type属性がfileのinput要素を操作します。
元々のコードは「vbsでフォームに値を入力できない - Visual Basic - 教えて!goo」のKenKen_SPさんが書かれたコードです。

Public Sub Sample()
  Const url As String = "http://hogehoge.hoge/up/"
  Const path As String = "C:\TEST\Sunset.jpg"
  
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .Navigate url
    
    '表示待ち
    While .Busy Or .ReadyState <> 4&
      DoEvents
    Wend
    
    'ファイルパスをクリップボードにコピー
    'CreateObject("htmlfile").parentWindow.clipboardData.setData "text", path
    With GetObject("new:1C3B4210-F441-11CE-B9EA-00AA006B1A69")
      .SetText path
      .PutInClipboard
    End With
    
    '対象となるinput要素をフォーカスしてファイルパスを貼り付け
    .document.getElementsByTagName("input")("upfile").Focus
    .ExecWB 13, 0
    
    '"アップロード"ボタンクリック
    .document.getElementsByTagName("input")("up").Click
  End With
End Sub

 

検索でヒットした語句をハイライト表示する

Webページ内で文字列検索を行い、ヒットした語句をハイライト表示します。
元々のコードは「971-2 | 再びwebBrowserにて - VB初心者友の会 - Q&A掲示板過去ログ」の魔界の仮面弁士さんが書かれたコードです。

Public Sub Sample()
  Const word As String = "リボン" '検索語
  
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .Navigate "http://www.google.co.jp/search?hl=ja&q=Office+%E3%83%AA%E3%83%9C%E3%83%B3"
    
    '表示待ち
    While .Busy Or .ReadyState <> 4&
      DoEvents
    Wend
    
    'ヒットした語句の背景を黄色に設定
    With .document.body.createTextRange
      Do While .findText(word)
        .execCommand "BackColor", False, "YELLOW"
        .collapse False 'ヒットした語句の末尾にカーソル移動
      Loop
    End With
  End With
End Sub

 

新しいタブでページを開く

新しいタブでページを開きます。
Navigate、Navigate2メソッドの引数「Flags」に「navOpenInNewTab(&H800)」を指定します。
Navigate Method (InternetExplorer, WebBrowser)」「Navigate2 Method (InternetExplorer, WebBrowser)」「BrowserNavConstants Enumeration」参照。

Public Sub Sample()
  Const url As String = "http://www.google.co.jp/"
  Const url2 As String = "http://www.yahoo.co.jp/"
  Const navOpenInNewTab = &H800
  
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .Navigate url
    
    '表示待ち
    While .Busy Or .ReadyState <> 4&
      DoEvents
    Wend
    
    '新しいタブで表示
    .Navigate2 url2, navOpenInNewTab 'もしくは[.Navigate url2, CLng(navOpenInNewTab)]
  End With
End Sub

 

画像をクリップボードにコピーする

Webページ上の画像をクリップボードにコピーします。

Public Sub Sample()
  Dim elm As Object
  Dim r As Object
  
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .Navigate "http://www.yahoo.co.jp/"
    
    '表示待ち
    While .Busy Or .ReadyState <> 4&
      DoEvents
    Wend
    
    Set r = .document.body.createControlRange
    For Each elm In .document.getElementsByTagName("img")
      If elm.getAttribute("alt") = "Yahoo! JAPAN" Then
        r.Add elm
        r.Select
        .ExecWB 12, 0
        Exit For
      End If
    Next
    Set r = Nothing
  End With
End Sub