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 件のコメント:
コメントを投稿