| |
こんばんは
クチコミはメインページを更新するたびに表示される内容が変わりますね。
>ページの情報を大本のページを表示してフレーム内に収まっている状態で取得したい
どう取得したいのか分からないので外れかもと思いますけど、
Sub test()
Dim ObjIE1 As Object
'アドレスの前にh t t p : / / を追加して実行して下さい。
Const MyURL1 As String = "www.jalan.net/kankou/"
Const MyURL2 As String = "www.jalan.net/jalan/doc/kankou/lank_spot_all.html"
Const MyURL3 As String = "www.jalan.net/ou/oup1000/ouw1003.do"
Worksheets("Sheet1").UsedRange.Delete
Set ObjIE1 = CreateObject("InternetExplorer.Application")
With ObjIE1
.Visible = True
.Navigate MyURL1
Do While .Busy = True
DoEvents
Loop
Call Webクエリ(MyURL2, Worksheets("Sheet1").Range("A1"))
Call Webクエリ(MyURL3, Worksheets("Sheet1").Range("B1"))
Do While .ReadyState <> 4
Loop
End With
End Sub
Sub Webクエリ(url As String, r As Range)
With ActiveSheet.QueryTables.Add( _
Connection:="URL;" & url, _
Destination:=r)
.Name = "lank_area_all"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
一旦シート上にＷＥＢクエリを設定してしまえば、Excelメニューのデータ更新でクチコミは次から次へと内容が変わります。
|
|
ウッシ
- 12/10/20(土) 1:23 -
