ムラゴン ホーム
注文をEXCELマクロで自動化 奮闘中
株注文の自動化は、楽天証券のマーケットスピードできるようですが、これをEXCELのマクロ（VBA）でできないか、試行錯誤中です。
Sub 買注文()
Set ob = CreateObject("MSXML2.XMLHTTP")
'ログイン
X1 = "?loginid=XXXXXXXXXXX"
X2 = "&passwd=XXXXXXXXXXX"
param = X1 + X2
url = "https://member.rakuten-sec.co.jp/app/Login.do" + param
y = send_get(ob, url)
If InStr(y, "現在メンテナンス中のためシステムを使用できません。") > 0 Then
Stop
End If
'セッションID取得し、銘柄入力画面へ
p0 = InStr(y, "location.href = " + Chr(34) + "/app/com_page_template.do;BV_SessionID")
If p0 = 0 Then Stop: 'ログイン出来ない時
P1 = InStr(p0 + 1, y, ";")
p2 = InStr(P1 + 1, y, "?")
ses = Mid(y, P1, p2 - P1)
url = "https://member.rakuten-sec.co.jp/app/ord_jp_stk_search.do" + ses + "?eventType=init&trdKbn=10&gmn=H&smn=01&lmn=&fmn="
y = send_get(ob, url)
'銘柄CD入力から注文画面へ
url = "https://member.rakuten-sec.co.jp/app/ord_jp_stk_search.do" + ses + "?gmn=J&smn=05&lmn=01&fmn=01"
銘柄CD = "6740": 'ジャパンディスプレイのCD
X1 = "dscrCdNm=" + 銘柄CD
X2 = "&marketCd=0"
X3 = "&industryCd=0"
X4 = "&checkUnitLessReal=0"
X5 = "&checkUnitLess=0"
X6 = "&offsetRow="
X7 = "&trdKbn=10"
X8 = "&pageNo=1"
X9 = "&eventType=search"
X10 = "&type="
X11 = "&sub_type="
X12 = "&local="
X13 = "&searchLog="
param = X1 + X2 + X3 + X4 + X5 + X6 + X7 + X8 + X9 + X10 + X11 + X12 + X13
y = send_post(ob, url, param)
If InStr(y, "東証・名証で該当する銘柄はありませんでした。入力内容をご確認ください。") > 0 Then
Stop
End If
If InStr(y, "現物取引（買い注文 / 受付）") = 0 Then
Stop
End If
'注文画面から確認画面へ
url = "https://member.rakuten-sec.co.jp/app/ord_jp_stk_new.do" + ses + "?gmn=J&smn=05&lmn=01&fmn=01"
z = "marketOrderSubstitutePricePriority"
X1 = Mid(name_value(y, z), 2, 1000)
z = "marketOrderSubstitutePriceStkBuy"
X2 = name_value(y, z)
z = "marketOrderSubstitutePriceStkSell"
X3 = name_value(y, z)
z = "marketOrderSubstitutePriceMgnBuy"
X4 = name_value(y, z)
z = "marketOrderSubstitutePriceMgnSell"
X5 = name_value(y, z)
X6 = "&ordSetSorFlag=on"
株数 = "100"
X7 = "&orderValue=" + 株数
x = "<td class=" + Chr(34) + "price-01" + Chr(34) + "><nobr>"
p = InStr(y, x)
If p = 0 Then Stop
P1 = p + Len(x)
p2 = InStr(P1, y, "<")
指値 = Trim(Str(Val(Mid(y, P1, p2 - P1)) + 2)): '指値は現在値＋２円でセット
X8 = "&marketOrderPrice=" + 指値
X9 = "&marketOrderKbn=0"
X10 = "&datepicker="
X11 = "&accountCd=1"
X12 = "&doSetOrder=0"
X13 = "&setOrderPriceKbn="
X14 = "&setOrderPrice="
X15 = "&setOrderPriceKbn="
X16 = "&profitMarginPrice="
X17 = "datepickerForSetOrder="
X18 = "&password=XXXXXXX"
x19 = "&checkbox=true"
X20 = "&dscrCd=" + 銘柄CD
z = "orderSequence"
X21 = name_value(y, z)
z = "dscrNm"
銘柄名称 = name_value(y, z)
x22 = 銘柄名称
X23 = "&hiddenMarketCd=1"
X24 = "&marketNm=東証"
X25 = "&stopOrderType=0"
X26 = "&tradeType=3"
X27 = "&lessUnitServiceKbn="
X28 = "&lessUnitCondKbn="
X29 = "&accountCd=1"
X29 = "&newStopOrderType="
X30 = "&priceFlag=1"
X31 = "&marketExecCond=1111111"
X32 = "&waitExecCond=1100100"
X33 = "&selMarketCd=1"
X34 = "&eventType=newCheck"
X35 = "&type=null"
X36 = "&sub_type="
X37 = "&local="
X38 = "&hiddenOrdSetSorFlag=1"
X39 = "&selMarketCd=1"
x40 = "&execCondCd=3": '寄付でセット
z = "<sselect name=" + Chr(34) + "ordValDate" + Chr(34)
日付 = Right(name_value(y, z), 10)
X41 = "&ordValDate=" + 日付
X42 = "&setExecCondCd=1"
X43 = 日付
param = X1 + X2 + X3 + X4 + X5 + X6 + X7 + X8 + X9 + X10 + X11 + X12 + X13 + X14 + X15 + X16 + X17 + X18 + x19 + X20 + X21 + x22 + X23 + X24 + X25 + X26 + X27 + X28 + X29 + X30 + X31 + X32 + X33 + X34 + X35 + X36 + X37 + X38 + X39 + x40 + X41 + X42 + X43
y = send_post(ob, url, param)
If InStr(y, "現物対当取引（クロス取引）になる可能性がございますので、ご注文を受付けられません。") > 0 Then
Stop
End If
If InStr(y, "（買い注文 / 確認）") = 0 Then
Stop
End If
'確認画面で注文
以下は、まだ作成中。
End Sub
Function name_value(y, z)
P1 = InStr(y, z)
If P1 = 0 Then Value = "err"
p2 = InStr(P1, y, "value")
P3 = InStr(p2, y, Chr(34))
P4 = InStr(P3 + 1, y, Chr(34))
name_value = "&" + z + "=" + Mid(y, P3 + 1, P4 - P3 - 1)
End Function
Function send_get(ob, url)
ob.Open "GET", url, False
ob.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
ob.send ("")
Do While ob.ReadyState < 4
DoEvents
Loop
send_get = ob.ResponseText
End Function
Function send_post(ob, url, x)
ob.Open "post", url, False
ob.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
ob.send (x)
Do While ob.ReadyState < 4
DoEvents
Loop
send_post = ob.ResponseText
End Function