【VBA】Openステートメントでバイナリファイルを読み書きする

0

    <機能>
    (1)Openステートメントを使用してバイナリデータ(500バイト)をファイルに書き込みます
    (2)Openステートメントを使用してバイナリデータをファイルから読み込みます
    (3)読み込んだ結果をシートにダンプ出力します

    <使い方>
    適当な場所にソース全体を貼り付けてBinaryMainを呼び出してください

    <イメージ>
    実行結果、バイナリ、読み込み、書き込み、VBA

     

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

    'バイナリファイルの入出力テスト メインプログラム

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

    Sub BinaryMain()

        Dim strFile As String

        

        '//ファイル名を生成

        strFile = ThisWorkbook.Path & "¥binaryTest.dat"

        

        '//全て(数式、文字列、書式、コメント、アウトライン)クリア

        Cells.Select

        Selection.Clear

        Selection.Font.Name = "MS ゴシック"

        Selection.Font.Size = 12

        Range("A1").Select

        

        '//バイナリデータをファイルへ書き込み(テストデータファイルを作成)

        Call WriteBinaryFile(strFile)

        

        '//バイナリファイルを読み込み(テストデータファイルを読み込み)

        Call ReadBinaryFile(strFile)

    End Sub

     

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

    'バイナリデータをテストファイルに出力

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

    Sub WriteBinaryFile(ByVal strfil As String)

        '//バイナリファイルの1バイト毎の入出力にはByte型を用いる

        Dim buff(499) As Byte

        Dim i As Integer

        Dim fp As Long

        

        '//書き込みデータをセット(500バイトのテストデータを用意)

        For i = 0 To 499

            buff(i) = (i Mod 256)

        Next

        

        '//FreeFile関数で使用可能なファイル番号を割り当て

        fp = FreeFile

        

        '//ファイルが存在する場合は指定アドレスが上書きされるだけのため

        '//書き込み前にファイルを削除するか中身を一旦クリアする

        Open strfil For Output As #fp

        Close (fp)

        

        '//ファイルオープン(バイナリ書き込みでオープン、ファイルが存在しない場合は新規作成)

        '//Openステートメントを用いてファイルの入出力を行います

        '//モードに下記のいずれかが指定されていればファイルが存在しない場合、新規作成されます

        '//追加モード(Append)、バイナリモード(Binary)、出力モード(Output)、ランダムアクセスモード(Random)

        '//※https://msdn.microsoft.com/ja-jp/library/office/gg264163.aspx

        Open strfil For Binary Access Write As #fp

        

        '//ファイルに書き込み(ファイル先頭からの書き込みを明示)

        Put #fp, 1, buff

        

        '//ファイルを閉じる

        Close (fp)

    End Sub

     

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

    'テストファイルからバイナリデータを読み込み

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

    Sub ReadBinaryFile(ByVal strfil As String)

        Dim buff() As Byte

        Dim fp As Long

        Dim filesize As Long, NowLoc As Long

        Dim idx As Long, gyo As Long

        Dim strBinary As String

        

        '//FreeFile関数で使用可能なファイル番号を割り当て

        fp = FreeFile

        

        '//ファイルを開く

        Open strfil For Binary As #fp

        

        '//ファイルサイズ分の読み込み領域を確保して読み込む場合の実装例

        'ReDim buff(FileLen(strfil))

        'Get #fp, 1, buff

        '//実装例ここまで

        

        '//ヘッダ情報をシートに出力

        Cells(1, 1) = "         00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F "

        Cells(2, 1) = "---------------------------------------------------------"

        

        '//ファイルの終端まで指定サイズ(最大16バイト)繰り返し読み込む

        gyo = 3

        Do While NowLoc < LOF(fp)

            

            '//最大16バイト分の領域を確保し初期化

            If (LOF(fp) - NowLoc) >= 16 Then

                '//残りのファイルサイズが16バイト以上のとき

                ReDim buff(15)

            Else

                '//最終読み込み時(497バイト〜500バイト目)は残りのファイルサイズが16未満

                ReDim buff(LOF(fp) - NowLoc - 1)

            End If

            

            '//データを読み込み

            Get #fp, , buff

            

            '//表示用のアドレスを生成("00000000"とHexの戻り値を連結した文字列の右から8文字)

            strBinary = Right("00000000" & Hex(NowLoc), 8) & " "

            

            '//現在位置をを保持する(ループBreak判定用)

            NowLoc = Loc(fp)

            

            '//出力文字列を生成

            For idx = 0 To UBound(buff)

                strBinary = strBinary + Right("00" & Hex(buff(idx)), 2) + " "

            Next

            

            '//シートの1列目に結果を表示

            Cells(gyo, 1) = strBinary

            gyo = gyo + 1

        Loop

        

        '//ファイルを閉じる

        Close (fp)

    End Sub

     

    よろしければポチッと押してください

    プログラマー ブログランキングへ



    calendar

    S M T W T F S
       1234
    567891011
    12131415161718
    19202122232425
    2627282930  
    << November 2017 >>

    profile

    others

    mobile

    qrcode