VBAでWEB上のデータを変数に代入するには？

質問

VBAで仕事上のデータを処理するシステムを作成しており、
どうしてもWEB上のデータを変数に入れたいのですが、どのような方法が良いでしょうか？

取得したいデータは関税協会にある為替相場です。
http://www.kanzei.or.jp/check/rate_all/2012/20120318.htm
上記のページに行くとアメリカ合衆国の為替レートが81.33というのがわかります。

VBA上の変数に81.33という数値を入れる方法を教えてください。
よろしくお願いします。

回答No.2

NOBNNN

先に#1　の方も答えていますが　ＥＸＣＥＬで実験してみました。

とりあえず　下記ソースをモジュールとして貼り付け、マクロを実行してみてください。

やり方は
(1) http://kabu-macro.com/kouza/kabuka_shutoku/kueri.html
(2) http://kabu-macro.com/kouza/kabuka_shutoku/macro_kabuka.html
(3) http://www.d3.dion.ne.jp/~jkondou/excelvba/T2.htm

を参考にしています。

ただ性能的には遅く、ＶＢ.ＮＥＴ2008 などで　ご自分で別なDLL　として作成したほうがいいかも
外部クラス参照でＶＢＡからできるようにすれば可能です。

++++++++++++++++++<サンプルソース> +++++++++++++++++++

Option Explicit

Const cns_WkSheet = "_ExchengeSheet"

Sub USD_Yen_GET()

Dim FindFlg As Boolean: FindFlg = False

Dim strAnser As String: strAnser = Empty

Dim MyRange As Range

Dim NowSheet As String

NowSheet = ActiveSheet.Name

With Worksheets.Add()
.Name = cns_WkSheet
End With

With ThisWorkbook.Worksheets(cns_WkSheet)
.Activate
End With

Call Exchenge_WEB_GET

Set MyRange = Columns("A:B").Find(What:="アメリカ合衆国") '"アメリカ合衆国"の文字列を探す

If Not (MyRange Is Nothing) Then '見つかったか？
If MyRange.Offset(0, 1) = "ドル(USD)" Then 'レートの文字 "ドル(USD)"があるか？
strAnser = MyRange.Offset(0, 2)
FindFlg = True
End If
End If

With ThisWorkbook.Worksheets(cns_WkSheet)
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

ThisWorkbook.Worksheets(NowSheet).Select

If FindFlg Then
MsgBox "アメリカ合衆国 ドル(USD) は（" & strAnser & "円)です。"
Else
MsgBox "為替（アメリカ合衆国）の値が見つかりません。", vbExclamation
End If
End Sub

Private Sub Exchenge_WEB_GET()
'
' Macro1 Macro
' マクロ記録日 : 2012/3/18
'
' 外部データの取得 Webクエリ
'
' ActiveWorkbook.Worksheets.Add
With ThisWorkbook.Worksheets(cns_WkSheet).QueryTables.Add(Connection:= _
"URL;http://www.kanzei.or.jp/check/rate_all/2012/20120318.htm", Destination:= _
Range("A1"))
.Name = "20120318"
.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
+++++++++++++++++++++++++++++++