Public oXMLHTTP As New MSXML2.xmlhttp
Public Function ShowHTML(ByVal strURL, Optional ByVal strName = "") As String
On Error GoTo ErrorHandler
Dim strError As String
strError = ""
Dim strResponse As String
strResponse = ""
With oXMLHTTP
.Open "GET", strURL, False
.send ""
If .Status <> 200 Then
strError = .statusText
GoTo CleanUpAndExit
Else
If strName <> "" Then
Dim outtext As Long
outtext = FreeFile
Open ActiveWorkbook.Path & "\" & strName & ".txt" For Output As #outtext
Write #outtext, .responseText
Close #outtext
End If
strResponse = .responseText
End If
End With
CleanUpAndExit:
On Error Resume Next ' Avoid recursive call to error handler
' Clean up code goes here
Set oXMLHTTP = Nothing
' Report any error
If Len(strError) > 0 Then
MsgBox strError
Else
ShowHTML = strResponse
End If
Exit Function
ErrorHandler:
strError = Err.Description
Resume CleanUpAndExit
End Function
Sub test1()
repstr = ShowHTML("http://kagen88.blogspot.jp/")
ActiveSheet.Range("A1") = repstr
End Sub
Sub test2()
Set shFirstQtr = Workbooks(1).Worksheets(1)
Set qtQtrResults = shFirstQtr.QueryTables _
.Add(Connection:="URL;http://kagen88.blogspot.jp/", _
Destination:=shFirstQtr.Cells(1, 1))
With qtQtrResults
'.WebFormatting = xlAll
.WebFormatting = xlWebFormattingAll
.Refresh
End With
Dim timeToRun As Date
timeToRun = Now + TimeValue("0:00:05")
Application.OnTime timeToRun, "doSomething" '5秒を待って "doSomething"を実行
End Sub
Sub doSomething()
'Do Anything
End Sub
2013年5月23日木曜日
web pageをゲットの2種方法 xmlhttp と querytables、querytablesの取得完了を待ってから処理する
ラベル:
vba
登録:
コメントの投稿 (Atom)
0 件のコメント:
コメントを投稿