金融機関からダウンロードしたCSV形式の明細データを、Excelのマクロを使用してMicrosoft Moneyに取り込む方法

Microsoft Moneyが2011年11月31日でサポート終了となり、同時に私が利用しているクレジット会社のサイトからMoney用に明細をダウンロードできる機能が終了してしまいました。この機能を重宝していた私は今後もMoneyを継続使用したいのにさて困った、という状態になったのですが、同じページからダウンロードできるCSV形式の明細データから、Moneyに取り込めるOFX形式に変換するプログラムをExcelのVBAで組んでみたところ、うまくいきました。

同じお悩みをお持ちの方がいるかと思い、少し手直しして公開してみることにしました。

あくまでこれは私の契約しているクレジット会社や銀行のサイトからダウンロードできるCSVファイルに対応したものなので、CSVのフォーマットが異なると正常には変換されません。その場合は自分の利用している金融機関のCSVファイルを開いてフォーマットを確認し、VBAの修正をする必要があります。

なお、今のところ動作確認できている金融機関は、

• ヨドバシゴールドポイントカード
• 三井住友VISAカード
• 横浜銀行
• 三菱UFJニコスカード（ユーザ様からの報告）
• 三菱東京UFJ銀行（ユーザ様からの報告）
• DCカード（ユーザ様からの報告）
• 住信SBIネット銀行（ユーザ様からの報告）

です。他にうまく動いたというケースがあれば、差し支えない範囲でかまわないので、下記アドレスまでメールをいただけるとありがたいです。その際、金融機関名と、CSVフォーマット情報をお知らせください。

メールの宛先はこちら。（画像ファイルなので、手でコピーしてください）

以下に変換用のVBAを公開します。 赤字 の部分が、自分の環境によって修正が必要な部分です。これをExcelの個人用マクロブック(PERSONAL.XLS)のModule1などに記述し、金融機関の明細のCSVファイルを開いた状態でマクロを実行すると、自動的にフォーマットを変換したファイルを作成し、Moneyを起動して取り込んでくれます。うまくいかない場合はCSVファイルの形式を再確認するなどしてください。

※ 個人用マクロブックに関してはここでは詳しく説明しないので、以下のサイトなどを参考にしてください。
個人用マクロブックの作成方法と使い方

最後に、このVBAを使用した結果、Moneyのデータが壊れるなどの現象が生じても責任は一切負いかねます。試してみる前に、Moneyのデータファイルをバックアップしておくことを推奨します。あくまでも自己責任で使用してください。個別の質問、相談にも、努力はしてみますが回答できないことがあるのでご容赦ください。

コードの始まり（ここから）

まずはじめに、モジュールの先頭に以下を記述します。

Option Explicit

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long _
) As Long

64bit環境の場合は、Declare Function の行を以下のようにしてください。

Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

Option Explicit は既に定義されている場合は不要です。

続いて、CSVファイルのフォーマット定義です。Sub〜End Subがひとつの金融機関の定義です。

マクロ中の const 文は、自分の金融機関のCSVファイルのフォーマットにしたがって修正する必要があります。

複数のカードをお持ちの方は、金融機関ごとにマクロ(Sub〜End Sub)を記述してください。

例として、作者が利用しているヨドバシゴールドポイントカード、三井住友VISAカード、横浜銀行の３種類のコードを掲載しておきます。

※ 2014年11月19日追記：Const CardName は、コメントに「自分がわかれば何でもいい」と表記していましたが、ユーザからのご指摘で、正確に入力しなければ正常に動作しない場合があることが判明し、曖昧な表記を削除するという修正を行いました。

'金融機関別マクロ

Sub ヨドバシゴールドポイントカードCSV取り込み  'マクロ名は自分がわかる名前に変更してください。
    'ユーザ固有の情報を設定
    Const CardName = "ヨドバシゴールドポイントカード" '金融機関名
    Const CardNumber = "0123456789012***"  'カード番号

    'CSVファイルのフォーマット
    ' 列番号はA=1,B=2,C=3,....に対応するので自分のCSVファイルのフォーマットにしたがって修正すること
    Const Begin = 1         '明細データが始まる行番号
    Const DateNum = 1       '日付が記載されている列番号
    Const TekiyouNum = 2    '摘要（支払先）が記載されている列番号
    Const KingakuNumOut = 7 '利用金額が記載されている列番号
    Const KingakuNumIn = 7  '入金金額が記載されている列番号（クレジットのように入出金額が同じ列の場合は、上と同じ列番号を記入）
    call Money取り込み(CardName, CardNumber, Begin, DateNum, TekiyouNum, KingakuNumOut, KingakuNumIn)
End Sub

Sub 三井住友VISAカードCSV取り込み   'マクロ名は自分がわかる名前に変更してください。
    'ユーザ固有の情報を設定
    Const CardName = "三井住友VISAカード" '金融機関名
    Const CardNumber = "0123456789012***" 'カード番号

    'CSVファイルのフォーマット
    ' 列番号はA=1,B=2,C=3,....に対応するので自分のCSVファイルのフォーマットにしたがって修正すること
    Const Begin = 2         '明細データが始まる行番号
    Const DateNum = 1       '日付が記載されている列番号
    Const TekiyouNum = 2    '摘要（支払先）が記載されている列番号
    Const KingakuNumOut = 6 '利用金額が記載されている列番号
    Const KingakuNumIn = 6  '入金金額が記載されている列番号（クレジットのように入出金額が同じ列の場合は、上と同じ列番号を記入）
    call Money取り込み(CardName, CardNumber, Begin, DateNum, TekiyouNum, KingakuNumOut, KingakuNumIn)
End Sub

Sub 横浜銀行CSV取り込み 'マクロ名は自分がわかる名前に変更してください。 
    'ユーザ固有の情報を設定
    Const CardName = "横浜銀行" '金融機関名
    Const CardNumber = "0123456789012***" '口座番号

    'CSVファイルのフォーマット
    ' 列番号はA=1,B=2,C=3,....に対応するので自分のCSVファイルのフォーマットにしたがって修正すること
    Const Begin = 2         '明細データが始まる行番号
    Const DateNum = 1       '日付が記載されている列番号
    Const TekiyouNum = 6    '摘要が記載されている列番号
    Const KingakuNumOut = 2 '出金金額が記載されている列番号
    Const KingakuNumIn = 3  '入金金額が記載されている列番号
    call Money取り込み(CardName, CardNumber, Begin, DateNum, TekiyouNum, KingakuNumOut, KingakuNumIn)
End Sub

作者は動作確認していませんが、以下はユーザ様からの報告による金融機関別のCSVファイルのフォーマットです。

三菱UFJニコスカードの場合

Sub 三菱UFJニコスカードCSV取り込み 'マクロ名は自分がわかる名前に変更してください。 
    Const CardName = "三菱UFJニコスカード" '金融機関名
    Const CardNumber = "0123456789012***" 'カード番号

    'CSVファイルのフォーマット（三菱UFJニコスカードの場合）
    ' 列番号はA=1,B=2,C=3,....に対応するので自分のCSVファイルのフォーマットにしたがって修正すること
    Const Begin = 14        '明細データが始まる行番号
    Const DateNum = 1       '日付が記載されている列番号
    Const TekiyouNum = 4    '摘要（支払先）が記載されている列番号
    Const KingakuNumOut = 6 '利用金額が記載されている列番号
    Const KingakuNumIn = 6  '入金金額が記載されている列番号
    call Money取り込み(CardName, CardNumber, Begin, DateNum, TekiyouNum, KingakuNumOut, KingakuNumIn)
End Sub

三菱東京UFJ銀行の場合

Sub 三菱東京UF銀行CSV取り込み 'マクロ名は自分がわかる名前に変更してください。 
    Const CardName = "三菱東京UFJ銀行 '金融機関名
    Const CardNumber = "0123456789012***" 'カード番号

    'CSVファイルのフォーマット（三菱東京UFJ銀行の場合）
    ' 列番号はA=1,B=2,C=3,....に対応するので自分のCSVファイルのフォーマットにしたがって修正すること
    Const Begin = 2        '明細データが始まる行番号
    Const DateNum = 1       '日付が記載されている列番号
    Const TekiyouNum = 3    '摘要（支払先）が記載されている列番号
    Const KingakuNumOut = 4 '利用金額が記載されている列番号
    Const KingakuNumIn = 5  '入金金額が記載されている列番号
    call Money取り込み(CardName, CardNumber, Begin, DateNum, TekiyouNum, KingakuNumOut, KingakuNumIn)
End Sub

ＤＣカードの場合

Sub ＤＣカードCSV取り込み 'マクロ名は自分がわかる名前に変更してください。 
    Const CardName = "ＤＣカード" '金融機関名
    Const CardNumber = "0123456789012***" 'カード番号

    'CSVファイルのフォーマット（DCカードの場合）
    ' 列番号はA=1,B=2,C=3,....に対応するので自分のCSVファイルのフォーマットにしたがって修正すること
    Const Begin = 14        '明細データが始まる行番号
    Const DateNum = 1       '日付が記載されている列番号
    Const TekiyouNum = 4    '摘要（支払先）が記載されている列番号
    Const KingakuNumOut = 6 '利用金額が記載されている列番号
    Const KingakuNumIn = 6  '入金金額が記載されている列番号
    call Money取り込み(CardName, CardNumber, Begin, DateNum, TekiyouNum, KingakuNumOut, KingakuNumIn)
End Sub

住信SBIネット銀行の場合

Sub 住信SBIネット銀行CSV取り込み 'マクロ名は自分がわかる名前に変更してください。 
    Const CardName = "住信SBIネット銀行" '金融機関名
    Const CardNumber = "0123456789012***" 'カード番号

    'CSVファイルのフォーマット（DCカードの場合）
    ' 列番号はA=1,B=2,C=3,....に対応するので自分のCSVファイルのフォーマットにしたがって修正すること
    Const Begin = 2        '明細データが始まる行番号
    Const DateNum = 1       '日付が記載されている列番号
    Const TekiyouNum = 2    '摘要（支払先）が記載されている列番号
    Const KingakuNumOut = 3 '利用金額が記載されている列番号
    Const KingakuNumIn = 4  '入金金額が記載されている列番号
    call Money取り込み(CardName, CardNumber, Begin, DateNum, TekiyouNum, KingakuNumOut, KingakuNumIn)
End Sub

以下は共通のサブルーチンです。上のコードの続きに書いてください。
注意：上記のプログラム内部から呼び出されるので、マクロの実行画面からは直接実行しないでください。

'共通サブルーチンマクロ

Sub Money取り込み(CardName, CardNumber, Begin, DateNum, TekiyouNum, KingakuNumOut, KingakuNumIn)

    ' 金融機関の明細ページからダウンロードしたCSVファイルを
    ' Microsoft Moneyで取り込めるOFX形式に変換し、Moneyを自動起動して取り込む

    '定数定義
    Const JST = "[+9:JST]"
    Const Indent = vbTab

    '現在開いているCSVファイルの作成日付を取得
    Dim InFileName As String, fs As Object
    Dim Created As String, CreatedStr As String
    InFileName = ActiveWorkbook.FullName
    Set fs = CreateObject("Scripting.FileSystemObject")
    Created = fs.getfile(InFileName).DateCreated
    CreatedStr = Format(Created, "yyyymmddHHMMSS") & JST
    Set fs = Nothing
    
    '最初と最後の明細の日付を取得
    Dim FirstDate As String, LastDate As String
    FirstDate = Format(Cells(Begin, DateNum), "yyyymmdd") & "000000" & JST
    LastDate = Format(Cells(Rows.Count, DateNum).End(xlUp), "yyyymmdd") & "000000" & JST

    'ヘッダ作成
    Dim Header As String
    Header = _
        "OFXHEADER:100" & vbCrLf & "DATA:OFXSGML" & vbCrLf & _
        "VERSION:102" & vbCrLf & "SECURITY:NONE" & vbCrLf & _
        "ENCODING:UTF-8" & vbCrLf & "CHARSET:CSUNICODE" & vbCrLf & _
        "COMPRESSION:NONE" & vbCrLf & "OLDFILEUID:NONE" & vbCrLf & _
        "NEWFILEUID:NONE" & vbCrLf
        
    Header = Header & _
        "<OFX>" & vbCrLf & _
        "<SIGNONMSGSRSV1>" & vbCrLf & "<SONRS>" & vbCrLf & _
        "<STATUS><CODE>0<SEVERITY>INFO</STATUS>" & vbCrLf & _
        "<DTSERVER>" & CreatedStr & vbCrLf & _
        "<LANGUAGE>JPN" & vbCrLf & "<FI>" & vbCrLf & _
        "<ORG>" & CardName & vbCrLf & "</FI>" & vbCrLf & _
        "</SONRS>" & vbCrLf & "</SIGNONMSGSRSV1>" & vbCrLf & _
        "<CREDITCARDMSGSRSV1>" & vbCrLf & "<CCSTMTTRNRS>" & vbCrLf & _
        "<TRNUID>0" & vbCrLf & "<STATUS><CODE>0<SEVERITY>INFO</STATUS>" & vbCrLf & _
        "<CCSTMTRS>" & vbCrLf & "<CURDEF>JPY" & vbCrLf & _
        "<CCACCTFROM>" & vbCrLf & "<ACCTID>" & CardNumber & vbCrLf & _
        "</CCACCTFROM>" & vbCrLf & "<BANKTRANLIST>" & vbCrLf & _
        "<DTSTART>" & FirstDate & vbCrLf & "<DTEND>" & LastDate & vbCrLf

    ' CSV１行をSGMLに変換
    Dim i As Integer
    Dim Meisai As String '利用明細
    Dim DateStr As String '利用日
    Dim Tekiyou As String '利用店名
    Dim Kingaku As Long '利用金額
    Dim Total As Long 'トータル金額

    For i = Begin To Cells(Rows.Count, DateNum).End(xlUp).Row
        If IsDate(Cells(i, DateNum).Value) Then
            DateStr = Format(Cells(i, DateNum), "yyyymmdd") & "000000" & JST
            Tekiyou = Cells(i, TekiyouNum)
            '明細に取り込む金額を取得
            '（クレジットの場合、利用金額と入金額は同一の列で、入金の場合はマイナスで計上される）
            If KingakuNumOut = KingakuNumIn Then
                Kingaku = -Cells(i, KingakuNumOut)
            Else
                Kingaku = Cells(i, KingakuNumIn) - Cells(i, KingakuNumOut)
            End If
            Total = Total + Kingaku
            Meisai = Meisai & _
                "<STMTTRN>" & vbCrLf & _
                Indent & "<TRNTYPE>PAYMENT" & vbCrLf & _
                Indent & "<DTPOSTED>" & DateStr & vbCrLf & _
                Indent & "<TRNAMT>" & Kingaku & vbCrLf & _
                Indent & "<FITID>0" & vbCrLf & _
                Indent & "<NAME>" & Tekiyou & vbCrLf & _
                "</STMTTRN>" & vbCrLf
        End If
    Next i
    
    'フッター
    Dim Footer As String
    Footer = _
        "</BANKTRANLIST>" & vbCrLf & "<LEDGERBAL>" & vbCrLf & _
        "<BALAMT>" & Total & vbCrLf & _
        "<DTASOF>" & CreatedStr & vbCrLf & _
        "</LEDGERBAL>" & vbCrLf & "</CCSTMTRS>" & vbCrLf & "</CCSTMTTRNRS>" & vbCrLf & _
        "</CREDITCARDMSGSRSV1>" & vbCrLf & "</OFX>"
    
    'OFXファイルをUTF-8で保存
    Dim OfxFileName As String
    OfxFileName = Environ("TEMP") & "\CSV2OFX.ofx"
    
    ' 文字コードにUTF-8を指定して書き出すOFXファイルのストリームをオープン
    Dim OutStream As Object
    Set OutStream = CreateObject("ADODB.Stream")
    OutStream.Open
    OutStream.CHARSET = "UTF-8" ' ファイルの文字コード
    OutStream.LineSeparator = -1 ' CRLF
    OutStream.Type = 2    ' テキスト
    ' ストリームへ書き出し 文字コード変換は ADODB.Stream がやってくれる
    OutStream.WriteText Header, 1
    OutStream.WriteText Meisai, 1
    OutStream.WriteText Footer, 1

    ' ファイル名を指定して保存し、クローズ
    OutStream.SaveToFile OfxFileName, 2
    OutStream.Close
    Set OutStream = Nothing
        
    'Moneyアプリを起動
    Dim rc As Long
    rc = ShellExecute(0, "open", OfxFileName, vbNullString, "", 5) '5 : SW_SHOW ウィンドウを現在の位置とサイズで表示

End Sub