|
カテゴリ:カテゴリ未分類
クリック証券のWebサービスで株式の約定一覧をexcelに取り込むマクロを作りました
こちらのサイトからログイン、約定一覧取得などキモ部分をまるまるコピーしました。ありがとうございます <前提> accountの名前のシートにユーザid,パスワードを置くこと Cells(2, 10).Value ユーザid Cells(3, 10).Value パスワード <取り込み仕様> 1列:受渡日 2列:銘柄コード 3列:売買区分 4列:約定数量 5列:約定単価 6列:受渡額 7列:手数料 10列:受付番号 <困った事、返答してくれない項目がある> 1)手数料、信用の諸経費 現物は受け渡し額・単価・数で計算できるが、信用は対応する新規約定と突き合せないとわからない→私の場合約定毎なので150円固定値にした。1日定額の方は、150円を0円に変更していただき、取り込み後に任意の行に手数料をセットしてください。1つのセルだけの操作でいけるはずです 諸経費はどうでもいいや。決済の額で損得計算できるから。そういう意味では手数料もどうでもいい 2)銘柄名 手で入力してください。ex:アイオーデータ[6916]の”アイオーデータ”は手で入力 ただし既に取り込んだ分をコードでサーチするようにしてあります。見つけた場合は銘柄名[コード]の形でセットします 以下ソースです uid = Worksheets("account").Cells(2, 10).Value passwd = Worksheets("account").Cells(3, 10).Value On Error GoTo Err: With ActiveWorkbook.Worksheets(ActiveWorkbook.ActiveSheet.Name) 行 = 5 Set XML = CreateObject("WinHttp.WinHttpRequest.5.1") Set doc = CreateObject("Microsoft.XMLDOM") doc.async = False XML.option(6) = False '6=WinHttpRequestOption_EnableRedirects 'リダイレクトさせない URL = "https://sec-sso.click-sec.com/webservice/ws-redirect?u=" & uid '2008/03/29 URL変更 XML.Open "GET", URL, False XML.send Location = XML.getResponseHeader("Location") 'リダイレクト先URLの取得 aa = InStr(Len("https://") + 1, Location, "/") 'https://kabu.click-sec.com/ の文字列数 bb = InStr(aa + 1, Location, "/") 'https://kabu.click-sec.com/sec1-6/ の文字列数 基底URL = Left(XML.getResponseHeader("Location"), bb - 1) XML.option(6) = True '6=WinHttpRequestOption_EnableRedirects URL = Location XML.Open "GET", URL, False XML.send Debug.Print XML.responseText doc.loadXML (XML.responseText) If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then msg = doc.documentElement.selectSingleNode("message").nodeTypedValue MsgBox "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]" Exit Sub End If 'シーケンス3 ユーザ認証とリダイレクトでURLをたどっていく URL = 基底URL & "/ws-login?j_username=" & uid & "&j_password=" & passwd XML.Open "GET", URL, False XML.send Debug.Print XML.responseText doc.loadXML (XML.responseText) If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue = "NG" Then If doc.documentElement.selectSingleNode("message").nodeTypedValue = "Authentication Failure." Then MsgBox ("ユーザIDまたはパスワードが誤っています") Exit Sub ElseIf doc.documentElement.selectSingleNode("message").nodeTypedValue = "Web service is not permitted." Then MsgBox ("GMOホームページに行って利用設定が必要です") Exit Sub Else msg = doc.documentElement.selectSingleNode("message").nodeTypedValue MsgBox "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]" Exit Sub End If ElseIf doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then msg = doc.documentElement.selectSingleNode("message").nodeTypedValue MsgBox "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]" Exit Sub End If Application.StatusBar = "Login完了" set_pos = 2 uri_torikomi = 0 kai_torikomi = 0 uri_c = 0 kai_c = 0 sin_uri_torikomi = 0 sin_kai_torikomi = 0 sin_uri_c = 0 sin_kai_c = 0 doc.async = False URL = 基底URL & "/ws/kabu/kabuYakujoList.do" XML.Open "GET", URL, False XML.send Debug.Print XML.responseText doc.loadXML (XML.responseText) If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then msg = doc.documentElement.selectSingleNode("message").nodeTypedValue Application.StatusBar = "GMOエラー " & msg Exit Sub End If Set ListItems = doc.documentElement.selectSingleNode("yakujoList").childNodes YakuNum = ListItems.Length YakuNum_Sumi = YakuNum For ii = 0 To YakuNum - 1 Set ListItem = ListItems.Item(ii) ' cmp_str = yakuteihi & m_name & "[" & m_code & "]" & syubetu & yakutei_no 'cmp_str = Replace(cmp_str, ",", "") uketuke_no_w = CStr(ListItem.selectSingleNode("chumonBango").nodeTypedValue) Set FoundCell = Range("j2", "j65536").Find(uketuke_no_w) If FoundCell Is Nothing Then YakuNum_Sumi = YakuNum_Sumi - 1 scode = ListItem.selectSingleNode("meigara").Attributes.getNamedItem("shokenCode").nodeTypedValue Set FoundCell = Range("b2", "b65536").Find(scode) If FoundCell Is Nothing Then m_name = "[" & scode & "]" Else m_name = FoundCell.Value End If ' If f = True Then Rows(CStr(set_pos) & ":" & CStr(set_pos)).Select Selection.Insert Shift:=xlDow Cells(set_pos, 1).Value = Replace(ListItem.selectSingleNode("ukewatashiBi").nodeTypedValue, "-", "/") Cells(set_pos, 2).Value = m_name If ListItem.selectSingleNode("baibai").nodeTypedValue = "2" Then syubetu = "買" Else syubetu = "売" End If If ListItem.selectSingleNode("torihiki").nodeTypedValue = "22" Then syubetu = "返済" & syubetu End If If ListItem.selectSingleNode("torihiki").nodeTypedValue = "21" Then syubetu = "信用" & syubetu End If If ListItem.selectSingleNode("torihiki").nodeTypedValue = "23" Then If syubetu = "買" Then syubetu = "現引" Else syubetu = "現渡" End If End If If InStr(syubetu, "現渡") > 0 Or InStr(syubetu, "現引") > 0 Then Else If InStr(syubetu, "信用") = 0 Then If InStr(syubetu, "買") > 0 Then kai_c = kai_c + 1 Else uri_c = uri_c + 1 End If Else If InStr(syubetu, "買") > 0 Then sin_kai_c = sin_kai_c + 1 Else sin_uri_c = sin_uri_c + 1 End If End If End If Cells(set_pos, 3).Value = syubetu yakujoSuryo = ListItem.selectSingleNode("yakujoSuryo").nodeTypedValue Cells(set_pos, 4).Value = yakujoSuryo yakujoTanka = ListItem.selectSingleNode("yakujoTanka").nodeTypedValue Cells(set_pos, 5).Value = yakujoTanka ukewatashiDaikin = ListItem.selectSingleNode("ukewatashiDaikin").nodeTypedValue Cells(set_pos, 6).Value = ukewatashiDaikin Cells(set_pos, 9).Value = 0 'yakutei_no Cells(set_pos, 10).Value = CStr(uketuke_no_w) 'uketuke_no(ii) fee = 150 If syubetu = "買" Then kai_torikomi = kai_torikomi + 1 If ukewatashiDaikin <> "" Then fee = (-1 * ukewatashiDaikin) - (yakujoSuryo * yakujoTanka) End If ElseIf syubetu = "売" Then uri_torikomi = uri_torikomi + 1 fee = yakujoSuryo * yakujoTanka - ukewatashiDaikin ElseIf syubetu = "返済売" Then sin_uri_torikomi = sin_uri_torikomi + 1 ElseIf syubetu = "返済買" Then sin_kai_torikomi = sin_kai_torikomi + 1 End If Cells(set_pos, 7).Value = fee set_pos = set_pos + 1 End If Next End With Application.StatusBar = "約定数=" & YakuNum & " 取込済=" & YakuNum_Sumi & " 売り取込=" & uri_torikomi & " 買い取込=" & kai_torikomi & " 売り取込済=" & uri_c - uri_torikomi & " 買い取込済=" & kai_c - kai_torikomi & _ "信用売り取込=" & sin_uri_torikomi & " 信用買い取込=" & sin_kai_torikomi & " 信用売り取込済=" & sin_uri_c - sin_uri_torikomi & " 信用買い取込済=" & sin_kai_c - sin_kai_torikomi doc.async = False URL = 基底URL & "/ws-logout" XML.Open "GET", URL, False XML.send doc.loadXML (XML.responseText) If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then GoTo Err: End If Set XML = Nothing Set doc = Nothing Exit Sub Err: Application.StatusBar = "エラーが発生しました" + vbCrLf + Err.Description お気に入りの記事を「いいね!」で応援しよう
最終更新日
2008.11.08 01:01:56
コメント(0) | コメントを書く |