Excel 2021のVBAでマネーフォワードの資産内訳をエクセルにインポートするプログラムのドラフトができました。

Excel 2021のVBAでマネーフォワードの資産内訳をエクセルにインポートするプログラムのドラフトができました。

昨晩から作業してようやくできたので、今のうちに公開しておきます。

まだできていないこと

1. このデータだと、現預金、投資信託などの資産クラス毎にテーブルの構成が異なるので、総資産や総損益を合算しにくいので、もう一工夫必要です。
2. FXや不動産など私が保有していない資産については、どのようなセクションIDになるのか知らないので実装できていません

Option Explicit

Public Sub 資産内訳のインポート()
Load UserForm1
    With UserForm1.WebBrowser1
        .Silent = True
    
        .Navigate "https://ssnb.x.moneyforward.com/users/sign_in"
    
        Call WaitIE(UserForm1.WebBrowser1)
    
        Dim htmldoc As HTMLDocument
        Set htmldoc = .Document

        Dim text_elem As HTMLInputElement
        Set text_elem = htmldoc.getElementById("sign_in_session_service[email]")
        If Not (text_elem Is Nothing) Then
            htmldoc.getElementById("sign_in_session_service[email]").Value = "xxxxxx@yahoo.co.jp" 'ユーザー名を指定
            htmldoc.getElementById("sign_in_session_service_password").Value = "xxxxxx" 'パスワードを指定
            htmldoc.getElementById("login-btn-sumit").Click
            Call WaitIE(UserForm1.WebBrowser1)
        End If
        Set htmldoc = Nothing
 
        .Navigate "https://ssnb.x.moneyforward.com/bs/portfolio"
        Call WaitIE(UserForm1.WebBrowser1)
    
        Set htmldoc = .Document
        Worksheets("MF").Range("E2").Select

        Call TableDump(htmldoc, "portfolio_det_depo")
        Worksheets("MF").Range("E12").Select
        Call TableDump(htmldoc, "portfolio_det_eq")
        Call TableDump(htmldoc, "portfolio_det_mgn")
        Call TableDump(htmldoc, "portfolio_det_mf")
        Call TableDump(htmldoc, "portfolio_det_bd")
        Call TableDump(htmldoc, "portfolio_det_ins")
        Call TableDump(htmldoc, "portfolio_det_pns")
    
        Set htmldoc = Nothing
    End With
    Unload UserForm1
End Sub
Private Sub WaitIE(objIE As Object)
 
    Do While objIE.Busy = True Or objIE.ReadyState < 4 '読み込み待ち
        '4=READYSTATE_COMPLETE
        DoEvents
    Loop
 
End Sub

Private Sub TableDump(htmldoc As HTMLDocument, section_id As String)
    Dim section_data As Object
    
    Set section_data = htmldoc.getElementById(section_id)
    
    Dim table_data As HTMLTable
    Set table_data = section_data.getElementsByTagName("table")(0)
    
    Dim table_row As HTMLTableRow
    Set table_row = table_data.getElementsByTagName("tr")(0)
    Dim table_row_count As Integer
    
    Let table_row_count = table_data.getElementsByTagName("tr").Length
    
    Dim tdcol As Integer
    Let tdcol = table_row.getElementsByTagName("th").Length
    
    Dim table_cell As HTMLTableCell
    For Each table_cell In table_row.getElementsByTagName("th")
        ActiveCell.Value = table_cell.innerText
        ActiveCell.Offset(0, 1).Select
    Next
    ActiveCell.Offset(1, -1 * tdcol).Select
    Dim row_index As Integer

   'RegExpオブジェクトの作成
    Dim reg As Object
    Set reg = CreateObject("VBScript.RegExp")
    
    '正規表現の指定
    With reg
        .Pattern = "円$"  'パターンを指定
        .IgnoreCase = False '大文字と小文字を区別するか(False)、しないか(True)
        .Global = True      '文字列全体を検索するか(True)、しないか(False)
    End With
    

    For row_index = 1 To table_row_count - 1
        Set table_row = table_data.getElementsByTagName("tr")(row_index)
        Let tdcol = table_row.getElementsByTagName("td").Length
        For Each table_cell In table_row.getElementsByTagName("td")
            ActiveCell.Value = reg.Replace(table_cell.innerText, "") '数値として扱いやすいように円を削除する
            ActiveCell.Offset(0, 1).Select
        Next
        ActiveCell.Offset(1, -1 * tdcol).Select
    Next
    Set reg = Nothing
End Sub

↓↓↓こちをらのブログも是非ごらんください。