[VBA]ExcelVBAでWebｻｰﾋﾞｽを読む。

----------------------------------------------------------

ExcelでWebｻｰﾋﾞｽを読む方法。（SOAP方式。ASP.NETで作成。）

----------------------------------------------------------

①Excel2003の場合は、「Web Service Toolkit」をダウンロード＋インストールしておくとよい。

　　2003じゃなくてももし完成後に文字化けするようであれば、それはSOAP3.0入手のためダウンロードした方がいいとか悪いとか。

　　http://www.blogger.com/blogger.g?blogID=6964513215018311715#editor/target=post;postID=8434087791579623391

②既存の[ツール]→[参照設定]→「Microsoft SOAP Type Library」にチェックをいれて、SOAPのコードをいじれるようにしておく。

③「MyWebService」というクラスを作成してソースを以下の様にします。赤文字の追記を参照のこと。

========================================================================

Private MyWebService As SoapClient30

Private Const c_WSDL_URL As String = "http://●●●.asmx?wsdl"
Private Const c_SERVICE As String = "●●●●"
Private Const c_PORT As String = "●●●●" '※上記アドレスをブラウザで直接見ればPortやService名,Namespaceは書いてあります。
Private Const c_SERVICE_NAMESPACE As String = "http://●●●●/"

Private Sub Class_Initialize()
'*****************************************************************
'クラスがインスタンス化されるたびに、このサブルーチンが呼び出されます。
'変数 sc_ComplexTypes に SoapClient30 を割り当てます。
'*****************************************************************
Dim str_WSML As String
str_WSML = ""
Set MyWebService = New SoapClient30
MyWebService.MSSoapInit2 c_WSDL_URL, str_WSML, c_SERVICE, c_PORT, c_SERVICE_NAMESPACE
'ProxyServer を <CURRENT_USER> に設定し、Internet Explorer の LAN 設定で定義されている
'プロキシ サーバーを使用します。
MyWebService.ConnectorProperty("ProxyServer") = "<CURRENT_USER>"
'Internet Explorer が自動検出に設定されている場合、EnableAutoProxy を True に設定して、
'プロキシ設定を自動検出するようにします。
MyWebService.ConnectorProperty("EnableAutoProxy") = True

End Sub
Private Sub Class_Terminate()
'*****************************************************************
'クラスが消滅するたびに、このサブルーチンが呼び出されます。
'変数 sc_ComplexTypes を Nothing に設定します。
'*****************************************************************
'エラー処理
On Error GoTo Class_TerminateTrap
Set MyWebService = Nothing
Exit Sub
Class_TerminateTrap:
WSRefScrCommonErrorHandler ("Class_Terminate")
End Sub
Private Sub WSRefScrCommonErrorHandler(str_Function As String)
'*****************************************************************
'このサブルーチンは、クラス エラー処理ルーチンです。
'サブルーチン、または関数でエラーが発生したときに呼び出されます。
'エラーが発生したサブルーチン名、または関数名とエラー内容を返します。
'*****************************************************************
' SOAP  エラー
If MyWebService.FaultCode <> "" Then
Err.Raise vbObjectError, str_Function, MyWebService.FaultString
' SOAP  以外のエラー
Else
Err.Raise Err.Number, str_Function, Err.Description
End If
End Sub
'=====================================================================
'↓↓使用する関数の宣言は以下に追加していきます↓↓
'=====================================================================
'例①：文字列(String)を投げて、文字列(String)で結果が返ってくる関数
 Public Function wsm_ExecuteScalar(ByVal str_SQL As String) As String
'エラー処理
On Error GoTo wsm_ExecuteScalarTrap
wsm_ExecuteScalar = MyWebService.ExecuteScalar(str_SQL)
Exit Function
wsm_ExecuteScalarTrap:
WSRefScrCommonErrorHandler "wsm_ExecuteScalar"
End Function

'例②：文字列（String）を投げて、データテーブル型で結果が返ってくる関数の場合は、DOMNodeListで宣言する！
Public Function wsm_GetDataTable(ByVal str_SQL As String) As MSXML2.IXMLDOMNodeList
'*****************************************************************
'"wsm_GetDataTable" は XML として定義されています。XML 変数の実装に関する詳細については、
'Microsoft Office 2003 Web Services Toolkit 2.0 ヘルプの「複合型 : XML」を参照してください。
'*****************************************************************
'エラー処理
On Error GoTo wsm_GetDataTableTrap
Set wsm_GetDataTable = MyWebService.GetDataTable(str_SQL)
Exit Function
wsm_GetDataTableTrap:
WSRefScrCommonErrorHandler "wsm_GetDataTable"
End Function
'=====================================================================
'↑↑使用する関数の宣言は以下に追加していきます↑↑
'=====================================================================

========================================================================
④作ったクラスを利用して、コードはこのように書きます。

========================================================================

Dim mySQL As String

mySQL = " SELECT * FROM 社員テーブル"
'Webｻｰﾋﾞｽから
Dim MyWebService As New MyWebService
Dim Nodes As MSXML2.IXMLDOMNodeList
Set Nodes = MyWebService.wsm_GetDataTable(mySQL)

'中身確認したい場合は
'For i = 0 To Nodes.Length - 1
' MsgBox i & "=>" & vbCrLf & Nodes(i).nodeName & "=>" & vbCrLf & Nodes(i).Text
' Nodes.NextNode
'Next


Dim xNode As MSXML2.IXMLDOMNode
Set xNode = Nodes(1) 'Nodes(0)はヘッダー情報ぽいのでNodes(1)だけでOk
Dim NodeList As MSXML2.IXMLDOMNodeList
Set NodeList = xNode.selectNodes("NewDataSet/tmp") '←Node名はWebｻｰﾋﾞｽによって変わる！あらかじめブラウザで結果を確認した方がヨイ

If NodeList.Length = 0 Then
　MsgBox ("対象データはありません")
　GoTo EndStep
End If


For Each obj In NodeList
'ここでセルに自由に加工する
With obj

Dim strMoji(16) As Variant
strMoji(0) = .childNodes(0).Text
strMoji(1) = .childNodes(1).Text
WS.Range(WS.Cells(intRow, 1), WS.Cells(intRow, 16)).Value = strMoji
End With

intRow = intRow + 1
Next

========================================================================