【自動売買】エクセル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通信をする仕組みは下記サイトを参考に作りました。詳しい解説を知りたい場合は下記サイトをご覧ください。
http://www.happy2-island.com/access/gogo03/capter90100.shtml

動作環境

動作環境は下記になります。

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

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



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」関数などを利用し、必要な情報を取得しています。クッキー情報の管理は、エクセル側で勝手に管理しているのでクッキー管理のプログラムを作る必要はありません。

さいごに

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

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