エクセルマクロ オンライン講座コメント紹介

コメント紹介
   └ エクセルマクロVBA「Web連携」
       └ エクセルマクロVBA「Web連携」Microsoft Internet ControlsならではのWebコンテンツの取得

エクセルマクロVBA「Web連携」Microsoft Internet ControlsならではのWebコンテンツの取得

[4052] 2015-04-06 23:49:21 受講生さんからの投稿です。

こんばんは。
東京青果情報センターからCSVファイルを抜き出すマクロを書いてみました。
ダウンロードボタンを押すところまで出来たのですが、その先がわかりません。
ダウンロードのダイアログボックスをコントロールすることは可能でしょうか。

Option Explicit
'以下に紹介するライブラリの参照設定をしてください
'Microsoft Internet Controls -> IEを制御するため
Sub 野菜()
    Dim objIE As New InternetExplorer, myrow As Long, i As Long
    objIE.Visible = True
    
    Dim url As String
    url = "http://www.info-seikabutu.jp/junpou_geppouNEW1.html?time="; & Format(Now, "yymmddhhnnss")
    '↑参考までに、SSLの場合もそのまま使えます。
    
    'テストページを、IDで読み込みます
    objIE.navigate url
    
    'ページの表示完了待ち
    Do While objIE.readyState <> 4 Or objIE.Busy = True
        DoEvents
    Loop
Dim oH
For Each oH In objIE.Document.getElementsBytagname("a")
If InStr(oH.innertext, "市場別入荷量と価格") > 0 Then
oH.Click
Exit For
End If
    
Next oH
objIE.Quit
End Sub






 


[4056] 2015-04-07 12:56:26 小川慶一さんからの投稿です。

匿名 さん:

InternetExplorerを使う限り、無理かと思います。
そこから先は、ショートカットキー操作でさくさくっとやる、というくらいではダメでしょうか?


>こんばんは。
>東京青果情報センターからCSVファイルを抜き出すマクロを書いてみました。
>ダウンロードボタンを押すところまで出来たのですが、その先がわかりません。
>ダウンロードのダイアログボックスをコントロールすることは可能でしょうか。

Option Explicit
'以下に紹介するライブラリの参照設定をしてください
'Microsoft Internet Controls -> IEを制御するため
Sub 野菜()
    Dim objIE As New InternetExplorer, myrow As Long, i As Long
    objIE.Visible = True
    
    Dim url As String
    url = "http://www.info-seikabutu.jp/junpou_geppouNEW1.html?time="; & Format(Now, "yymmddhhnnss")
    '↑参考までに、SSLの場合もそのまま使えます。
    
    'テストページを、IDで読み込みます
    objIE.navigate url
    
    'ページの表示完了待ち
    Do While objIE.readyState <> 4 Or objIE.Busy = True
        DoEvents
    Loop
Dim oH
For Each oH In objIE.Document.getElementsBytagname("a")
If InStr(oH.innertext, "市場別入荷量と価格") > 0 Then
oH.Click
Exit For
End If
    
Next oH
objIE.Quit
End Sub





 


[4058] 2015-04-07 18:12:34 受講生さんからの投稿です。

小川慶一 さん:
わかりました。ショートカットキー操作で対応してみます。


>匿名 さん:
>
>InternetExplorerを使う限り、無理かと思います。
>そこから先は、ショートカットキー操作でさくさくっとやる、というくらいではダメでしょうか?
>
>
>>こんばんは。
>>東京青果情報センターからCSVファイルを抜き出すマクロを書いてみました。
>>ダウンロードボタンを押すところまで出来たのですが、その先がわかりません。
>>ダウンロードのダイアログボックスをコントロールすることは可能でしょうか。
>
>
>Option Explicit
>'以下に紹介するライブラリの参照設定をしてください
>'Microsoft Internet Controls -> IEを制御するため
>Sub 野菜()
>    Dim objIE As New InternetExplorer, myrow As Long, i As Long
>    objIE.Visible = True
>    
>    Dim url As String
>    url = "http://www.info-seikabutu.jp/junpou_geppouNEW1.html?time="; & Format(Now, "yymmddhhnnss")
>    '↑参考までに、SSLの場合もそのまま使えます。
>    
>    'テストページを、IDで読み込みます
>    objIE.navigate url
>    
>    'ページの表示完了待ち
>    Do While objIE.readyState <> 4 Or objIE.Busy = True
>        DoEvents
>    Loop
>Dim oH
>For Each oH In objIE.Document.getElementsBytagname("a")
>If InStr(oH.innertext, "市場別入荷量と価格") > 0 Then
>oH.Click
>Exit For
>End If
>    
>Next oH
>objIE.Quit
>End Sub
>
>
>
>

>
>

 


[4067] 2015-04-09 10:05:36 小川慶一さんからの投稿です。

匿名 さん:

そうしてください。
それか、他のライブラリを使うかですね。


>小川慶一 さん:
>わかりました。ショートカットキー操作で対応してみます。
>
>
>>匿名 さん:
>>
>>InternetExplorerを使う限り、無理かと思います。
>>そこから先は、ショートカットキー操作でさくさくっとやる、というくらいではダメでしょうか?
>>
>>
>>>こんばんは。
>>>東京青果情報センターからCSVファイルを抜き出すマクロを書いてみました。
>>>ダウンロードボタンを押すところまで出来たのですが、その先がわかりません。
>>>ダウンロードのダイアログボックスをコントロールすることは可能でしょうか。
>>
>>
>>Option Explicit
>>'以下に紹介するライブラリの参照設定をしてください
>>'Microsoft Internet Controls -> IEを制御するため
>>Sub 野菜()
>>    Dim objIE As New InternetExplorer, myrow As Long, i As Long
>>    objIE.Visible = True
>>    
>>    Dim url As String
>>    url = "http://www.info-seikabutu.jp/junpou_geppouNEW1.html?time="; & Format(Now, "yymmddhhnnss")
>>    '↑参考までに、SSLの場合もそのまま使えます。
>>    
>>    'テストページを、IDで読み込みます
>>    objIE.navigate url
>>    
>>    'ページの表示完了待ち
>>    Do While objIE.readyState <> 4 Or objIE.Busy = True
>>        DoEvents
>>    Loop
>>Dim oH
>>For Each oH In objIE.Document.getElementsBytagname("a")
>>If InStr(oH.innertext, "市場別入荷量と価格") > 0 Then
>>oH.Click
>>Exit For
>>End If
>>    
>>Next oH
>>objIE.Quit
>>End Sub
>>
>>
>>
>>

>>
>>
>

 


[4091] 2015-04-15 21:24:38 受講生さんからの投稿です。

小川慶一 さん:
WinHTTPで気象庁のCSVファイルを読み込みセルに格納する
マクロを書いてみました。上手くはいったのですが、PHPSESSIDが
一定時間で変化してしまい、その対応がわかりません。また、他のパソコンでも
上手くいきませんでした。※PHPSESSIDは仮の値を入力しています。
これを回避する方法はあるのでしょうか?
Option Explicit
'以下に紹介するライブラリの参照設定をしてください
'Microsoft WinHTTP Services, version 5.1 -> HTTPリクエストをするため
'Microsoft ActiveX Data Objects X.X Library -> 文字化けを避けるため
Sub 気象庁データ抽出()
    Dim url As String, n As Long, mae As Date, ato As Date, ymd As String
    url = "http://www.data.jma.go.jp/gmd/risk/obsdl/show/table";

    mae = saigo
    If mae = Date Then
    MsgBox "データは最新です。" & vbCrLf & mae - 1
    Exit Sub
    End If
    ato = Date
    ymd = "[""a"",""b"",""c"",""d"",""e"",""f""]"
    ymd = Replace(ymd, "a", Year(mae))
    ymd = Replace(ymd, "b", Year(ato))
    ymd = Replace(ymd, "c", Month(mae))
    ymd = Replace(ymd, "d", Month(ato))
    ymd = Replace(ymd, "e", Day(mae))
    ymd = Replace(ymd, "f", Day(ato))
    
   
    Dim sp As String
    sp = "stationNumList=[""s47662""]&aggrgPeriod=1&elementNumList=[[""202"",""""],[""203"",""""],[""201"",""""],[""701"",""""],[""702"",""""]]&interAnnualFlag=1&ymdList=" & ymd & "&optionNumList=[]&downloadFlag=true&rmkFlag=1&disconnectFlag=1&youbiFlag=0&kijiFlag=0&huukouFlag=0&csvFlag=1&jikantaiFlag=0&jikantaiList=[]&ymdLiteral=1&PHPSESSID=sr575afgar3woiw"’PHPSESSIDEは仮の値
   ' Debug.Print sp
    Dim xh As New WinHttp.WinHttpRequest
    xh.Open "POST", url, False
    xh.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" '日本語を含む場合、サーバ側で文字化けを避けるために必要
  
    
    Dim bp() As Byte
    bp = StrConv(sp, vbFromUnicode)
    xh.send bp
    
    Dim sCode As String
    sCode = xh.Status
    If sCode <> 200 Then
        MsgBox "postに失敗しました" & vbNewLine & sCode
        Exit Sub
    End If

    Dim sHead As String
    Dim sBody As String
    
    sHead = xh.getAllResponseHeaders
  
    
    Dim strm As New ADODB.Stream
    strm.Open
    strm.Position = 0
    strm.Type = 1
    strm.Write xh.ResponseBody
    
    strm.Position = 0
    strm.Type = 2
    strm.Charset = "shift_jis"
    
    sBody = strm.ReadText
    
    strm.Close
    Set strm = Nothing
    
    Debug.Print sBody
    If InStr(sBody, "TigilError") > 0 Then
    MsgBox "データ量が多すぎます。", vbCritical
    Exit Sub
    End If
    
    Application.ScreenUpdating = False
    With Sheets("気象庁データ")
    .Cells.Clear
    Dim tmp, tmp2, i As Long, j As Long, data
    tmp = Split(sBody, vbCrLf)
    n = 1
    For i = 0 To UBound(tmp) - 1
    tmp2 = Split(tmp(i), ",")
    
    For j = 0 To UBound(tmp2)
    .Cells(n, j + 1) = tmp2(j)
    Next j
    n = n + 1
    Next i
    data = .Range("A7:P" & n - 1)
    End With
    
    With Sheets("天気")
    n = .Range("A" & Rows.Count).End(xlUp).Row + 1
    If n <= 1 Then n = 2
    For i = LBound(data) To UBound(data)
    .Cells(n, 1) = data(i, 1)
    .Cells(n, 2) = data(i, 2)
    .Cells(n, 3) = data(i, 5)
    .Cells(n, 4) = data(i, 8)
    .Cells(n, 5) = data(i, 11)
    .Cells(n, 6) = data(i, 14)
    n = n + 1
    Next i
    .Activate
    End With
  
    Application.ScreenUpdating = True
End Sub

Function saigo() As Date
 Dim i As Long, data, buf As Date

 With Sheets("天気")
 If .Range("A2") = "" Then
 saigo = "2010/1/1"
 Exit Function
 End If
 
 data = .Range("A1").CurrentRegion
 End With
    
 buf = data(2, 1)
 
 For i = 2 To UBound(data)
 If buf - data(i, 1) < 0 Then
 buf = data(i, 1)
 End If
 
 Next i
    

  saigo = buf + 1
End Function

>匿名 さん:
>
>そうしてください。
>それか、他のライブラリを使うかですね。
>
>
>>小川慶一 さん:
>>わかりました。ショートカットキー操作で対応してみます。
>>
>>
>>>匿名 さん:
>>>
>>>InternetExplorerを使う限り、無理かと思います。
>>>そこから先は、ショートカットキー操作でさくさくっとやる、というくらいではダメでしょうか?
>>>
>>>
>>>>こんばんは。
>>>>東京青果情報センターからCSVファイルを抜き出すマクロを書いてみました。
>>>>ダウンロードボタンを押すところまで出来たのですが、その先がわかりません。
>>>>ダウンロードのダイアログボックスをコントロールすることは可能でしょうか。
>>>
>>>
>>>Option Explicit
>>>'以下に紹介するライブラリの参照設定をしてください
>>>'Microsoft Internet Controls -> IEを制御するため
>>>Sub 野菜()
>>>    Dim objIE As New InternetExplorer, myrow As Long, i As Long
>>>    objIE.Visible = True
>>>    
>>>    Dim url As String
>>>    url = "http://www.info-seikabutu.jp/junpou_geppouNEW1.html?time="; & Format(Now, "yymmddhhnnss")
>>>    '↑参考までに、SSLの場合もそのまま使えます。
>>>    
>>>    'テストページを、IDで読み込みます
>>>    objIE.navigate url
>>>    
>>>    'ページの表示完了待ち
>>>    Do While objIE.readyState <> 4 Or objIE.Busy = True
>>>        DoEvents
>>>    Loop
>>>Dim oH
>>>For Each oH In objIE.Document.getElementsBytagname("a")
>>>If InStr(oH.innertext, "市場別入荷量と価格") > 0 Then
>>>oH.Click
>>>Exit For
>>>End If
>>>    
>>>Next oH
>>>objIE.Quit
>>>End Sub
>>>
>>>
>>>
>>>

>>>
>>>
>>
>

 


[4094] 2015-04-16 14:01:26 小川慶一さんからの投稿です。

匿名 さん:

レスポンスヘッダーで新しいPHPSESSIDを受け取ったら次のリクエストではそれを使う、というコードになると思います。
それで実装してみてください。

 


[4096] 2015-04-16 20:27:01 受講生さんからの投稿です。

小川慶一 さん:
レスポンスヘッダーの中身が以下なのですが、PHPSESSIDが見当たりません。
何かアプローチに問題がありそうでしょうか?

Cache-Control: max-age=600
Date: Thu, 16 Apr 2015 11:14:29 GMT
Pragma: no-cache
Content-Length: 910
Content-Type: "text/x-comma-separated-values"
Expires: 0
Server: Apache
Content-Disposition: attachment; filename="data.csv"
Content-Transfer-Encoding: binary
MS-Author-Via: DAV
X-Content-Type-Options: nosniff
X-Powered-By: PHP/5.3.3

>匿名 さん:
>
>レスポンスヘッダーで新しいPHPSESSIDを受け取ったら次のリクエストではそれを使う、というコードになると思います。
>それで実装してみてください。
>

 


[4100] 2015-04-18 15:05:20 小川慶一さんからの投稿です。

匿名 さん:

僕も、ちょっと勘違いしていたかも。

ブラウザーで動かしたときに取ってきたクッキーの値を基にPHPSESSIDを取得された、ということですが。

レスポンスで確実にPHPSESSIDを受け取れるリクエストを見つけられそうでしょうか。
(..と言っても無理かと思いますので。。解析方法について解説した追加動画を追ってお送りします)





>小川慶一 さん:
>レスポンスヘッダーの中身が以下なのですが、PHPSESSIDが見当たりません。
>何かアプローチに問題がありそうでしょうか?
>
>Cache-Control: max-age=600
>Date: Thu, 16 Apr 2015 11:14:29 GMT
>Pragma: no-cache
>Content-Length: 910
>Content-Type: "text/x-comma-separated-values"
>Expires: 0
>Server: Apache
>Content-Disposition: attachment; filename="data.csv"
>Content-Transfer-Encoding: binary
>MS-Author-Via: DAV
>X-Content-Type-Options: nosniff
>X-Powered-By: PHP/5.3.3
>
>>匿名 さん:
>>
>>レスポンスヘッダーで新しいPHPSESSIDを受け取ったら次のリクエストではそれを使う、というコードになると思います。
>>それで実装してみてください。
>>
>

 


まずはここから!スマホでも学べる無料動画講座

今なら先着30名限定で無料!定価4,800円の、初心者のためのエクセルマクロ動画講座。
  1. Excel 97~Excel 2016まですべて対応。動画本数20本、総再生時間2時間44分53秒
  2. PC, Mac, iPhone, iPad, Androidのお好みの環境で、いつでも好きなときに学べます。
2004年から10年間述べ3,000名以上に実施した研修の経験と実績を集約した講座です。
いますぐ無料で試してください。

トップへ