自分方位研究所

日々の活動記録

VBAでのマクロ実行中、VBEのイミディエイトウィンドゥに出力する「debug.print」の内容を外部テキストファイルへ出力。

Excelのマクロ コードに「debug.print」 コマンドを入れておくと、マクロ実行中の変数の内容や、処理の途中経過を、VBE(Visual Basic Editor)のイミディエイトウィンドゥへ出力してくれます。

とても便利なのですが、出力文字数が大きすぎると最初に表示されたものから順に消されていきます。そのため、WEBページのソースコードなど、大量の文字列を表示しようとすると、一部表示しきれない行が出てきます。また、イミディエイトウィンドゥは、表示エリアが小さいので 一覧性に欠けます。

ということで、debug.printで、ある程度まとまった文字列を表示しようとすると、どうしても外部ファイルへ出力して、改めてテキストエディタ等にて確認することになります。

Excel VBA では、OpenコマンドとPrintコマンドを使用して、外部ファイルへの出力をするのですが、私は今まで、T'sWare(ティーズウェア)さんのサイトで紹介されている「Debug.Printの内容をファイルに出力するサンプルプロシージャ」を利用させてもらっていました。

トップページの上部右側のメニュー群の中から、「Tips」を選択すると、Microsoft Access に関する大量のサンプルプログラムが紹介されています。

その中で、「#546 Debug.Printの内容をファイルに出力するサンプルプロシージャ」が、シンプルで使いやすいです。
Access のVBAに関するプログラムですが、Excel VBAでも問題なく動きます。

tsware.jp

このサイトで紹介されているコードでは、出力ファイル名、出力先フォルダは、固定であったため、それらが変更できるように、自分でも作成してみましたので紹介します。

Sub PrintData(prtDATA As Variant, _
                Optional fileName As String = "", _
                Optional dirPath As String = "")

'VBAでのマクロ実行中、VBEのイミディエイトウィンドゥに出力するdebug.printの内容を
'外部テキストファイルとして出力します。

'出力ファイル名が同じ場合には、元のデータに追記(Append)します。
'指定ファイル名に、使用禁止文字が混じっていた場合は、ファイル名を全角化して保存。

'使用例
'PrintDATA (prtDATA , [FileName,] [dirPath])

'・prtDATA  : 出力対象データ本体
'・FileName : 出力ファイル名 (省略可)
'・dirPath  : 出力フォルダフルパス (省略可)

'出力ファイル名と出力先フォルダフルパスを指定しない場合は以下を初期値としています。
'出力ファイル名 = "VBAdebugPrint.txt"
'出力先フォルダフルパス = このマクロを実行しているブックと同一のフォルダ


'Debug.Print "・prtDATA(出力文字本体。先頭30文字): _" & Left(prtDATA, 30) & ""
'Debug.Print "・FileName(出力ファイル名): _" & fileName & ""
'Debug.Print "・dirPath(出力先フォルダフルパス): _" & dirPath & ""
'Debug.Print "・dirPath(フォルダ存在確認結果): _" & Dir(dirPath, vbDirectory) & ""

'****************************************************
'ファイル名/フォルダパスが未指定のときのデフォルト値
Dim defFileName As String   '初期ファイル名
    defFileName = "VBAdebugPrint.txt"
Dim defDirPath As String    '初期出力フォルダパス
    defDirPath = ThisWorkbook.Path & "\"
'****************************************************

Dim outputFileName As String    '実際に使用するファイル名
    outputFileName = fileName
    If fileName = "" Then
        outputFileName = defFileName
    End If

Dim dirCheck As String  '出力先フォルダ存在確認
    dirCheck = Dir(dirPath, vbDirectory)
        'dirPathを指定しないとき、dirCheck = "."
        'dirPathが存在しないとき、dirCheck = ""
        'dirPathが存在するとき、dirCheck = dirPathの末端のフォルダ名

Dim outputPath As String    '実際の出力先フォルダ フルパス
    If dirCheck = "." Or dirCheck = "" Then
         outputPath = defDirPath
    Else
        outputPath = Trim(dirPath)
        If Right(outputPath, 1) <> "\" Then
            outputPath = outputPath & "\"
        End If
    End If
    
Dim fileNo As Byte  '使用可能なファイル番号(1~255)
    fileNo = FreeFile
Dim errCount As Byte    'ファイル名不正でのエラー発生カウンタ
    errCount = 0
    On Error GoTo ERROR_TRAP
    Open outputPath & outputFileName For Append As #fileNo
    On Error GoTo 0
    Print #fileNo, prtDATA
    Close #fileNo

PrintEnd:
Debug.Print prtDATA

Exit Sub
'--------------------------------------------------
ERROR_TRAP:

    If errCount = 0 Then
        outputFileName = StrConv(outputFileName, vbWide) & ".txt"
        errCount = errCount + 1
        Debug.Print "★ PrintDataのファイル名不正のため、ファイル名を全角に変換。"
        Debug.Print "★ → " & outputFileName
        Resume     'もう一度エラー発生行から実行
    Else
        '全角化でもエラーになるとき
        On Error GoTo 0
        Debug.Print "★ PrintDATAの出力中止"
        GoTo PrintEnd
    End If
End Sub


動作テスト

Sub TEST_PrintData()

'使用例
'PrintDATA (prtDATA , [FileName,] [dirPath])

'・prtDATA  : 出力対象データ本体
'・FileName : 出力ファイル名 (省略可)
'・dirPath  : 出力フォルダフルパス (省略可)


    PrintData "test1 *** " & Now
    PrintData "test2 *** " & Now, Date & ".txt"
    PrintData "test3 *** " & Now, "書き込みテスト.txt"

    PrintData "test4 *** " & Now
    PrintData "test5 *** " & Now, Date & ".txt"
    PrintData "test6 *** " & Now, "書き込みテスト.txt"

End Sub