2015-01-14 18:16:33

【自動売買】エクセルVBAを使って証券会社にログインし会員画面から情報を取得する

 普段、証券会社を利用し注文を出す際は、ブラウザや専用ツールを利用します。簡単に操作できますが、裏ではいろいろな技術が使われ運用されています。自動売買ツールを作る際は、この技術の知識が必要となります。自動売買ツールを作る前にそれらの技術を簡単に説明します。


  • SPONSORED LINK



ブラウザとは


 ブラウザとは簡単にいうとサーバと会話するコミュニケーションツールです。ユーザーはブラウザを通じサーバへ要求し、サーバはユーザーの要求に答えます。このようにしてサーバと会話します。会話には言語が必要です。人と人とが会話するとき、言語を使って意思疎通をします。しかし言語が違えば会話が成立しません。英語圏の人に日本語で会話してもお互い理解することはできません。これはサーバとの会話も同様です。サーバと会話する場合、言語が必要です。その言語にあたるのがプロトコルです。プロトコルは「約束事」と訳されます。

ブラウザは「http」というプロトコルを得意としています。ブラウザは「http」を使ってサーバと会話します。サーバにはいろいろなプロトコルを理解するソフトウェア達が常駐しています。言語が違えば意思疎通できないようにプロトコルも同様です。サーバ側も「http」を理解するソフトウェアが対応する必要があります。「http」を得意とするソフトウェアがブラウザの対応をし要求に答えます。

ブラウザはサーバからの返答をユーザーに伝えます。その返答は、人間にはわかりにくいものなのでブラウザは人間にわかりやすいように変換し画面に表示します。このようにユーザーは「http」を理解していなくてもブラウザを使いサーバとコミュニケーションできるわけです。よってブラウザはサーバと会話するコミュニケーションツールと言えます。


ネットワークとは


 ネットワークとは、データを指定の場所に運ぶ仕組みです。ブラウザはサーバに意思を伝えるためデータをインターネットというネットワーク網を使ってサーバに伝えます。この仕組みは、郵便局や宅急便などの配送システムと似ています。人は遠くの人になにか意思を伝えるために手紙を使います。手紙は宛先を記入した封筒に入れ郵便局を使って配送し相手に意思を伝えます。これはコンピュータネットワークも同様です。

手紙にあたるのがデータで、宛先にあたるのがドメインです。グーグルにアクセスするときブラウザに「www.google.co.jp」と入力すると思います。この「www.google.co.jp」がドメインになります。「www.google.co.jp」が宛先になり、インターネット網を使ってデータ(要求)を送ります。サーバはその要求に対応しデータをインターネット網を使って返答します。このような仕組みを使って遠くのサーバとデータのやりとりを行います。


エクセルを使って証券会社発注用ブラウザを作る


 上記の仕組みを理解した上でエクセルを使ってブラウザのようなものを作っていきます。なぜエクセルかというと3点の理由があります。

1.普及している
2.複雑なプログラムにも対応している
3.楽天RSSに対応している

エクセルはVBAというプログラム言語を利用することができます。このエクセルのVBAを利用し、httpプロトコルでサーバへの要求やサーバからの返答を解析し表示する仕組みを構築します。今回は「証券会社にログインし会員ページ内の情報を取得する」ところまで作っていきます。証券会社は「GMOクリック証券」を利用します。

当サイトでは技術的な解説はせず基本コピペで作っていきます。ソースコードを公開しているので技術的なことに興味がある方はそれを参考して勉強してください。またこれを実現するための知識は下記にまとめました。

▼必要な知識
通信とネットワークの仕組み
VBA(プログラム言語)
HTTPプロトコル(サーバとのコミュニケーションで使う)
TCPプロトコル(データの配送用プロトコル)
html(返答の解析で使う)


VBAを使ってHTTP通信をする仕組みは下記サイトを参考に作りました。詳しい解説を知りたい場合は下記サイトをご覧ください。
http://www.happy2-island.com/access/gogo03/capter90100.shtml


動作環境


動作環境は下記になります。
▼動作環境
Windows7
Excel2010
証券会社 GMOクリック証券



フォーム作成やライブラリのインクルード


 ソースをコピペする前にフォーム作成やライブラリのインクルードを行っていきます。まずエクセルを立ち上げます。下記の画像のようにフォームを作成してください。



C2にユーザー名
C4にログインID(書式設定 文字列)
E4にパスワード(書式設定 文字列)
B7に資産合計
に入力できるようにしてください。




「開発」タブをクリック
「Visual Basic」をクリック
「VBA」の入力画面が表示されます。




必要なライブラリを参照できるようにします。
「VBA」の入力画面から「ツール」タブ→「参照設定」をクリック
「Microsoft ActiveX Data Objects 2.8 Library」を選択します。




Sheet1上で右クリック
「挿入」を選択し「標準モジュール」を
クリックします。


ソースをコピペする


ソースは下記になります。

'API関数
Private Declare PtrSafe Function InternetOpen _
Lib "wininet.dll" _
Alias "InternetOpenA" _
(ByVal lpszAgent As String _
, ByVal dwAccessType As Long _
, ByVal lpszProxyName As String _
, ByVal lpszProxyBypass As String _
, ByVal dwFlags As Long) As Long

Private Declare PtrSafe Function InternetCloseHandle _
Lib "wininet.dll" _
(ByVal hInternet As Long) As Integer

Private Declare PtrSafe Function InternetConnect _
Lib "wininet.dll" _
Alias "InternetConnectA" _
(ByVal hInternet As Long _
, ByVal lpszServerName As String _
, ByVal nServerPort As Integer _
, ByVal lpszUsername As String _
, ByVal lpszPassword As String _
, ByVal dwService As Long _
, ByVal dwFlags As Long _
, ByVal dwContext As Long) As Long

Private Declare PtrSafe Function HttpOpenRequest _
Lib "wininet.dll" _
Alias "HttpOpenRequestA" _
(ByVal hConnect As Long _
, ByVal lpszVerb As String _
, ByVal lpszObjectName As String _
, ByVal lpszVersion As String _
, ByVal lpszReferer As String _
, ByVal lpszAcceptTypes As Long _
, ByVal dwFlags As Long _
, ByVal dwContext As Long) As Long

Private Declare PtrSafe Function HttpSendRequest _
Lib "wininet.dll" _
Alias "HttpSendRequestA" _
(ByVal hRequest As Long _
, ByVal lpszHeaders As String _
, ByVal dwHeadersLength As Long _
, ByVal lpOptional As String _
, ByVal dwOptionalLength As Long) As Integer

Private Declare PtrSafe Function HttpQueryInfo _
Lib "wininet.dll" _
Alias "HttpQueryInfoA" _
(ByVal hRequest As Long _
, ByVal dwInfoLevel As Long _
, ByRef lpvBuffer As Any _
, ByRef lpdwBufferLength As Long _
, ByRef lpdwIndex As Long) As Integer

Private Declare PtrSafe Function InternetReadFile _
Lib "wininet.dll" _
(ByVal hRequest As Long _
, ByRef lpBuffer As Any _
, ByVal dwNumberOfBytesToRead As Long _
, ByRef lpdwNumberOfBytesRead As Long) As Integer

Private Declare PtrSafe Function HttpAddRequestHeaders _
Lib "wininet.dll" _
Alias "HttpAddRequestHeadersA" _
(ByVal hHttpRequest As Long _
, ByVal sHeaders As String _
, ByVal lHeadersLength As Long _
, ByVal lModifiers As Long) As Integer

Private Declare PtrSafe Function InternetSetCookie Lib "wininet.dll" _
Alias "InternetSetCookieA" _
(ByVal lpszUrlName As String, _
ByVal lpszCookieName As String, _
ByVal lpszCookieData As String) As Boolean

Private Declare PtrSafe Function InternetGetCookie Lib "wininet.dll" _
Alias "InternetGetCookieA" _
(ByVal lpszUrlName As String, _
ByVal lpszCookieName As String, _
ByVal lpszCookieData As String, _
lpdwSize As Long) As Boolean

'API関数で使用する定数も定義
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Private Const INTERNET_FLAG_DONT_CACHE As Long = &H4000000
Private Const INTERNET_FLAG_RESYNCHRONIZE As Long = &H800
Private Const INTERNET_FLAG_NEED_FILE As Long = &H10
Private Const INTERNET_FLAG_HYPERLINK As Long = &H400
Private Const INTERNET_FLAG_NO_COOKIES As Long = &H80000
Private Const INTERNET_FLAG_NO_AUTO_REDIRECT As Long = &H200000
Private Const INTERNET_FLAG_SECURE = &H800000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_IGNORE_CERT_CN_INVALID = &H800000
Private Const INTERNET_FLAG_IGNORE_CERT_DATE_INVALID = &H800000
Private Const INTERNET_OPEN_TYPE_DIRECT As Long = &H1
Private Const INTERNET_OPEN_TYPE_PRECONFIG As Long = &H0
Private Const INTERNET_OPEN_TYPE_PROXY As Long = &H3
Private Const INTERNET_FLAG_ASYNC As Long = &H10000000
Private Const INTERNET_FLAG_FROM_CACHE As Long = &H1000000
Private Const INTERNET_DEFAULT_HTTP_PORT As Integer = 80
Private Const INTERNET_DEFAULT_HTTPS_PORT As Integer = 443
Private Const INTERNET_SERVICE_HTTP As Long = 3
Private Const HTTP_QUERY_CONTENT_TYPE As Long = 1
Private Const HTTP_QUERY_CONTENT_LENGTH As Long = 5
Private Const HTTP_QUERY_DATE As Long = 9
Private Const HTTP_QUERY_LAST_MODIFIED As Long = 11
Private Const HTTP_QUERY_STATUS_CODE As Long = 19
Private Const HTTP_QUERY_RAW_HEADERS_CRLF As Long = 22
Private Const HTTP_QUERY_LOCATION As Long = 33
Private Const HTTP_QUERY_SERVER As Long = 37
Private Const HTTP_QUERY_SET_COOKIE As Long = 43
Private Const HTTP_QUERY_COOKIE As Long = 44
Private Const HTTP_QUERY_REQUEST_METHOD As Long = 45
Private Const HTTP_ADDREQ_FLAG_ADD As Long = &H20000000
Private Const HTTP_ADDREQ_FLAG_REPLACE As Long = &H80000000
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const ERROR_INSUFFICIENT_BUFFER = 122

'定数定義
'環境によって変更してください
'*****************************************************************
'ダウンロードファイルの保存場所 :ドキュメントフォルダ
Private Const SAVE_DER As String = "C:\Users\*********\Documents"

'*****************************************************************

Private Const SAVE_FILE As String = "\000temp.tmp"
Private Const IDRANGE As String = "C4"
Private Const PASSRANGE As String = "E4"
Private Const USERRANGE As String = "C2"
Private Const ASSETRANGE As String = "B7"

'変数の定義
Private lngWinINet As Long
Private lngHttpHnd As Long
Private lngReqHnd As Long
Private strBuffer As String * 1024
Private lngLength As Long
Private bytDataArea() As Byte
Private lngDataLength As Long
Private lngSavePos As Long
Private idText As String
Private passText As String
Private PostData As String
Private c_dir As String


Sub login_Click()

'IDとパスワードを取得
idText = Range(IDRANGE).Value
passText = Range(PASSRANGE).Value

'IDチェック
If Len(idText) = 0 Then
MsgBox "IDを入力してください", vbExclamation
Exit Sub
End If

'パスワードチェック
If Len(passText) = 0 Then
MsgBox "パスワードを入力してください", vbExclamation
Exit Sub
End If


Dim lngRC As Long
Dim lngStatus As Long

'インターネットサービスオープン
lngRC = fcInternetOpen

'HTTPサーバとの接続と切断
If lngRC = 0 Then

'HTTPサーバ接続
lngRC = fcHTTPConnect("sec-sso.click-sec.com")

'リクエストを初期化
If lngRC = 0 Then
lngRC = fcHTTPOpenRequest("POST", "/mk/")
End If

'リクエストを送信
If lngRC = 0 Then
Call fcHttpAddRequestHeaders("Referer: https://sec-sso.click-sec.com/")
Call fcHttpAddRequestHeaders("Accept:text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")
Call fcHttpAddRequestHeaders("Accept-Language: ja,en-us;q=0.7,en;q=0.3")
Call fcHttpAddRequestHeaders("Accept-Encoding: gzip, deflate")
Call fcHttpAddRequestHeaders("Connection: keep-alive")
PostData = "j_username=" + idText + "&j_password=" + passText + "&LoginForm=%DB%B8%DE%B2%DD&p=80"

lngRC = fcHTTPSendRequest(PostData)
End If
lngRC = 0

'HTTPステータスコードを取得
If lngRC = 0 Then
lngRC = fcHTTPQueryInfo(HTTP_QUERY_STATUS_CODE)

'HTTPステータスコードを保存
lngStatus = CLng(strBuffer)

'HTTPステータスコードチェック
If lngStatus < 200 Or lngStatus > 299 Then
lngRC = 0
End If

End If


'ダウンロード
If lngRC = 0 Then
lngSavePos = 0
lngDataLength = 0
lngRC = fcHTTPReadFile
End If


'ファイルを保存
If lngRC = 0 Then
lngRC = fcDataSave(SAVE_DER, SAVE_FILE)
End If

'HTTPリクエストクローズ
Call fcHttpRequestClose

'切断
Call fcHTTPDisConnect

Dim sCookieVal As String * 256
Dim bRet As Boolean

If lngRC = 0 Then
'ソース解析
Dim buf As String
Dim tmp As Variant
Dim dir_tmp As Variant
Dim loginRes As Long
Open SAVE_DER + SAVE_FILE For Input As #1
Line Input #1, buf
Close #1

tmp = Split(buf, "
")
loginRes = InStr(1, tmp(1), "様", vbBinaryCompare)
If loginRes > 0 Then
MsgBox "ログイン成功"

'リンク先の取得
dir_tmp = Split(buf, "https://kabu.click-sec.com/")
dir_tmp = Split(dir_tmp(1), "/mk/")
c_dir = dir_tmp(0)

Range("C2").Value = LTrim(Replace(tmp(1), vbLf, ""))
Else
MsgBox "ログイン失敗 ID、パスワードを確認してください"
Range(USERRANGE).Value = ""
Range(ASSETRANGE).Value = ""
End If

'ダウンロードファイル削除
Kill SAVE_DER + SAVE_FILE
End If
End If
End Sub


Sub getAssets_Click()
Dim lngRC As Long
Dim lngStatus As Long

'インターネットサービスオープン
lngRC = fcInternetOpen

'HTTPサーバとの接続と切断
If lngRC = 0 Then

'HTTPサーバ接続
lngRC = fcHTTPConnect("kabu.click-sec.com")

'リクエストを初期化
If lngRC = 0 Then
lngRC = fcHTTPOpenRequest("GET", "/" + c_dir + "/mk/dispPaUserSheet.do")
End If

'リクエストを送信
If lngRC = 0 Then
Call fcHttpAddRequestHeaders("Referer: https://kabu.click-sec.com/" + c_dir + "/mk/dispKabuMenu.do")
Call fcHttpAddRequestHeaders("Accept:text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")
Call fcHttpAddRequestHeaders("Accept-Language: ja,en-us;q=0.7,en;q=0.3")
Call fcHttpAddRequestHeaders("Accept-Encoding: gzip, deflate")
Call fcHttpAddRequestHeaders("Connection: keep-alive")
PostData = ""

lngRC = fcHTTPSendRequest(PostData)
End If
lngRC = 0

'HTTPステータスコードを取得
If lngRC = 0 Then
lngRC = fcHTTPQueryInfo(HTTP_QUERY_STATUS_CODE)

'HTTPステータスコードを保存
lngStatus = CLng(strBuffer)

'HTTPステータスコードチェック
If lngStatus < 200 Or lngStatus > 299 Then
lngRC = 0
End If

End If


'ダウンロード
If lngRC = 0 Then
lngSavePos = 0
lngDataLength = 0
lngRC = fcHTTPReadFile
End If


'ファイルを保存
If lngRC = 0 Then
lngRC = fcDataSave(SAVE_DER, SAVE_FILE)
End If

'HTTPリクエストクローズ
Call fcHttpRequestClose

'切断
Call fcHTTPDisConnect

If lngRC = 0 Then
'ソース解析
Dim buf As String
Dim tmp As Variant
Dim loginRes As Long
Dim docRes As Long
Open SAVE_DER + SAVE_FILE For Input As #1
Line Input #1, buf
Close #1

docRes = InStr(1, buf, "保有資産時価評価額合計", vbBinaryCompare)

If docRes > 0 Then
tmp = Split(buf, "保有資産時価評価額合計")
tmp = Split(tmp(1), "円")
loginRes = InStr(1, tmp(0), "right", vbBinaryCompare)
End If

If loginRes > 0 Then
MsgBox "取得成功"
Range(ASSETRANGE).Value = LTrim(Replace(Replace(tmp(0), vbLf, ""), "
", ""))
Else
MsgBox "取得失敗"
Range(ASSETRANGE).Value = ""
End If

Kill SAVE_DER + SAVE_FILE
End If
End If
End Sub

Sub logout_Click()

Dim lngRC As Long
Dim lngStatus As Long

'インターネットサービスオープン
lngRC = fcInternetOpen

'HTTPサーバとの接続と切断
If lngRC = 0 Then

'HTTPサーバ接続
lngRC = fcHTTPConnect("kabu.click-sec.com")

'リクエストを初期化
If lngRC = 0 Then
lngRC = fcHTTPOpenRequest("GET", "/" + c_dir + "/mobile-logout")
End If

'リクエストを送信
If lngRC = 0 Then
Call fcHttpAddRequestHeaders("Referer: https://kabu.click-sec.com/" + c_dir + "/mk/dispKabuMenu.do")
Call fcHttpAddRequestHeaders("Accept:text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")
Call fcHttpAddRequestHeaders("Accept-Language: ja,en-us;q=0.7,en;q=0.3")
Call fcHttpAddRequestHeaders("Accept-Encoding: gzip, deflate")
Call fcHttpAddRequestHeaders("Connection: keep-alive")
PostData = ""

lngRC = fcHTTPSendRequest(PostData)
End If
lngRC = 0

'HTTPステータスコードを取得
If lngRC = 0 Then
lngRC = fcHTTPQueryInfo(HTTP_QUERY_STATUS_CODE)

'HTTPステータスコードを保存
lngStatus = CLng(strBuffer)

'HTTPステータスコードチェック
If lngStatus < 200 Or lngStatus > 299 Then
lngRC = 0
End If

End If


'ダウンロード
If lngRC = 0 Then
lngSavePos = 0
lngDataLength = 0
lngRC = fcHTTPReadFile
End If


'ファイルを保存
If lngRC = 0 Then
lngRC = fcDataSave(SAVE_DER, SAVE_FILE)
End If

'HTTPリクエストクローズ
Call fcHttpRequestClose

'切断
Call fcHTTPDisConnect


If lngRC = 0 Then
'ソース解析
Dim buf As String
Dim tmp As Variant
Dim loginRes As Long
Open SAVE_DER + SAVE_FILE For Input As #1
Line Input #1, buf
Close #1

loginRes = InStr(1, buf, "ログアウト", vbBinaryCompare)
If loginRes > 0 Then
MsgBox "ログアウト成功"
Range(USERRANGE).Value = ""
Range(ASSETRANGE).Value = ""
Else
MsgBox "ログアウト失敗"
Range(USERRANGE).Value = ""
Range(ASSETRANGE).Value = ""
End If

Kill SAVE_DER + SAVE_FILE

End If

End If

End Sub


Function fcHTTPConnect(Server As String) As Long

'APIの実行 接続
lngHttpHnd = InternetConnect(lngWinINet _
, Server _
, INTERNET_DEFAULT_HTTPS_PORT _
, vbNullString _
, vbNullString _
, INTERNET_SERVICE_HTTP _
, 0 _
, 0)

fcHTTPConnect = Err.LastDllError

End Function

Function fcHTTPDisConnect() As Long

'APIの実行 切断
Call InternetCloseHandle(lngHttpHnd)
fcHTTPDisConnect = Err.LastDllError

End Function

Function fcInternetOpen() As Long

'APIの実行 インターネットサービスオープン
lngWinINet = InternetOpen(vbNullString _
, INTERNET_OPEN_TYPE_PRECONFIG _
, vbNullString _
, vbNullString _
, 0)

'この関数の戻り値には、APIの処理結果コードを返します
fcInternetOpen = Err.LastDllError

End Function

Function fcInternetClose() As Long

'APIの実行 インターネットサービスクローズ
Call InternetCloseHandle(lngWinINet)
fcInternetClose = Err.LastDllError

End Function

Function fcHTTPOpenRequest(strMethod As String, strURL As String) As Long

Dim tmpURL As String * 255
Dim lngSecFlag As Long
lngSecFlag = INTERNET_FLAG_SECURE Or _
INTERNET_FLAG_IGNORE_CERT_CN_INVALID Or _
INTERNET_FLAG_IGNORE_CERT_DATE_INVALID Or _
INTERNET_FLAG_RELOAD

'URL
tmpURL = strURL

'APIの実行 リクエスト初期化
lngReqHnd = HttpOpenRequest(lngHttpHnd _
, strMethod _
, tmpURL _
, "HTTP/1.1" _
, vbNullString _
, 0 _
, lngSecFlag _
, 0)

fcHTTPOpenRequest = Err.LastDllError

End Function

Function fcHTTPSendRequest(strPostData As String) As Long

Dim strHeader As String

'ヘッダー情報
strHeader = "Content-Type: application/x-www-form-urlencoded"

'API実行 リクエスト送信
Call HttpSendRequest(lngReqHnd _
, strHeader _
, Len(strHeader) _
, strPostData _
, Len(strPostData))

fcHTTPSendRequest = Err.LastDllError

End Function

Function fcHttpRequestClose() As Long

'APIの実行 インターネットサービスクローズ
Call InternetCloseHandle(lngReqHnd)
fcHttpRequestClose = Err.LastDllError

End Function

Function fcHTTPQueryInfo(lngInfoLevel As Long) As Long

Dim tmpIndex As Long

lngLength = 1024
strBuffer = vbNullString
tmpIndex = 0

'APIの実行 応答を取得
Call HttpQueryInfo(lngReqHnd _
, lngInfoLevel _
, ByVal strBuffer _
, lngLength _
, tmpIndex)

fcHTTPQueryInfo = Err.LastDllError

End Function
Function fcHTTPReadFile() As Long

Dim tmpIndex As Long
Dim lngSize As Long
Dim i As Long
Dim tmpBuffer(1023) As Byte

'ファイルを受信
Do

strBuffer = vbNullString
lngSize = 0

'ファイルを取得
Call InternetReadFile(lngReqHnd _
, tmpBuffer(0) _
, 1024 _
, lngSize)


'データの保存
If Err.LastDllError = 0 Then

If lngSize = 0 Then
Exit Do
End If

lngDataLength = lngDataLength + lngSize
ReDim Preserve bytDataArea(lngDataLength)

For i = 0 To lngSize - 1
bytDataArea(lngSavePos) = tmpBuffer(i)
lngSavePos = lngSavePos + 1
Next

End If

Loop

If lngDataLength > 0 Then
ReDim Preserve bytDataArea(lngDataLength - 1)
End If

fcHTTPReadFile = Err.LastDllError

End Function

Function fcDataSave(strPath As String, strFileName) As Long

'ADO.Stream
Dim objADOStream As New ADODB.Stream
Dim objFS As Object

Set objFS = CreateObject("Scripting.FilesystemObject")

'バイナリモードで保存
objADOStream.Type = adTypeBinary
objADOStream.Open
objADOStream.Write bytDataArea

'データ上書き保存
objADOStream.SaveToFile objFS.BuildPath(strPath, strFileName) _
, adSaveCreateOverWrite

objADOStream.Close

Set objFS = Nothing
Set objADOStream = Nothing

fcDataSave = Err.LastDllError

End Function
Function fcHttpAddRequestHeaders(pHeader As String) As Long

Dim lngRC As Long

'APIの実行 ヘッダー設定
lngRC = HttpAddRequestHeaders(lngReqHnd _
, pHeader _
, Len(pHeader) _
, HTTP_ADDREQ_FLAG_REPLACE _
Or HTTP_ADDREQ_FLAG_ADD)

fcHttpAddRequestHeaders = CBool(lngRC)

End Function

ソースコードをダウンロード
ソースコードをダウンロードしコピペしてください。



左のメニューから「Modul1」をダブルクリックし入力画面がでてきたらソースをコピペします。

コピペ後ソースコードから「ダウンロードファイルの保存場所」を設定してください。
'定数定義
'環境によって変更してください
'*****************************************************************
'ダウンロードファイルの保存場所 :ドキュメントフォルダ
Private Const SAVE_DER As String = "C:\Users\*********\Documents"

'*****************************************************************



プログラム起動ボタンを作成し起動確認




上部のメニューから「挿入」をクリックし「起動ボタン」を作成します。
上の画像のようにボタンを作ると「マクロの登録」ウィンドウが出現します。
「ログイン」ボタンに「login_Click」を選択
「資産取得」ボタンに「getAssets_Click」を選択
「ログアウト」ボタンに「logout_Click」を選択しボタンと
プログラムを紐付けします。




プログラムの起動確認をします。
C4に証券会社のIDをE4にパスワードを入力してください。
「ログイン」ボタンを押しログインに成功すると「ユーザー名」が
C2に表示されます。
「資産取得」ボタンを押すとB7に資産が表示されます。
「ログアウト」ボタンをログアウトします。

以上情報を取得できれば成功となります。


ソース解説


http通信には「winInet」API関数を使用しています。これらのAPIを利用しサイトからデータをダウンロードしています。ダウンロードしたデータを「Split」関数などを利用し、必要な情報を取得しています。クッキー情報の管理は、エクセル側で勝手に管理しているのでクッキー管理のプログラムを作る必要はありません。


さいごに


このプログラムを利用する際は、ある程度知識が必要です。わからない場合は勉強してから利用してみてください。質問などはコメント欄に記入してください。

※このプログラムを利用して起こった、いかなる損害に対しても賠償責任を負いません。利用は自己責任でお願いします。




記事検索