Public objIE As InternetExplorer
Public objTag As Object
Public objOption As Object
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
'********************************************************
'プロシージャ名:test1
'プロシージャの説明:yahooをIEで表示する
'条件内容:位置[top=0,left=0]、サイズ[W600×H600]
'********************************************************
Sub test1()
'Call ieView(objIE, "http://yahoo.co.jp")
Call ieView(objIE, "C:\Users\xxx\Desktop\test\html\a.html")
Dim shtTemp As Worksheet
Sleep 1000
' MsgBox ("OK")
With objIE
' .document.body.Focus
' .document.execCommand "SelectAll"
' .document.execCommand "Copy"
objIE.ExecWB 17, 0 'OLECMDID_SELECTALL = 17 全てを選択
objIE.ExecWB 12, 0 'OLECMDID_COPY = 12 コピー
End With
Set shtTemp = ThisWorkbook.Worksheets("Sheet2")
shtTemp.Select
shtTemp.Range("A1").Select
'Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End Sub
'********************************************************
'プロシージャ名:ieView
'プロシージャの説明:IE表示
'引数:objIE = 対象のIEオブジェクト
' :urlName = 表示するURL
' :viewFlg = 表示?非表示
' :ieTop = ブラウザのTOP位置
' :ieLeft = ブラウザのLEFT位置
' :ieWidth = ブラウザの幅
' :ieHeight = ブラウザの高さ
'********************************************************
Sub ieView(objIE As InternetExplorer, urlName As String, Optional viewFlg As Boolean = True, Optional ieTop As Integer = 0, Optional ieLeft As Integer = 0, Optional ieWidth As Integer = 600, Optional ieHeight As Integer = 600)
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = viewFlg
objIE.Top = ieTop
objIE.Left = ieLeft
objIE.Width = ieWidth
objIE.Height = ieHeight
objIE.navigate urlName
Call ieCheck(objIE)
End Sub
'********************************************************
'プロシージャ名:ieCheck
'プロシージャの説明:IEが完全表示されまでループする
'引数:objIE = 対象のIEオブジェクト
'********************************************************
Sub ieCheck(objIE As InternetExplorer)
Dim timeout As Date
timeout = Now + TimeSerial(0, 0, 10)
Do While objIE.Busy = True Or objIE.readyState <> 4
DoEvents
Sleep 100
If Now > timeout Then
objIE.Refresh
timeout = Now + TimeSerial(0, 0, 10)
End If
Loop
timeout = Now + TimeSerial(0, 0, 10)
Do Until objIE.document.readyState = "complete"
DoEvents
Sleep 100
If Now > timeout Then
objIE.Refresh
timeout = Now + TimeSerial(0, 0, 10)
End If
Loop
End Sub
选择IE全部内容,被拷贝到excel
最新推荐文章于 2021-06-20 23:50:01 发布