【VBA】FSOでファイル情報出力/バイナリから指定サイズ切り出す

0

    <機能>

    (1)FileSystemObjectのGetFileメソッドでファイル情報を取得する

    (2)Openステートメントでバイナリファイルの指定位置から指定サイズだけ切り出す

     

    <イメージ>

    ファイル情報を出力します

    バイナリファイルの指定位置から指定サイズ分取得して別ファイルに切り出します

    ※サンプルでは50000バイト目から10000バイト分を切り出します

     

    <動作検証&開発環境>
    Microsoft Office 2016

     

    <使い方>

    (1)参照設定を行います
    [Alt]+[F11]でVBE(VBAエディター)を表示します
    メニューの[ツール(T)]から[参照設定(R)]を選択します
    Microsoft Scripting Runtimeをチェックして[OK]を押下してください

     

    (2)標準モジュールを追加します

    (3)ソースを貼り付けます

     

    '********************************************
    'ファイル情報を表示する
    'GetFileの詳細は
    DeveloperNetwork参照
    '********************************************

    Public Sub ファイル情報を表示する()
        On Error GoTo lblerror
        Dim filename As String
        Dim myfso As FileSystemObject, myinfo As Object
        Dim sret As String

        '//テストファイルパス
        filename = ThisWorkbook.Path + "¥testpicture.jpg"
        '//FSOオブジェクトを取得する
        Set myfso = CreateObject("Scripting.FileSystemObject")

        '//ファイル情報を取得する
        Set myinfo = myfso.GetFile(filename)
        sret = "【File】" + vbCrLf
        '//パス
        sret = sret + myinfo.Path + vbCrLf
        '//ファイル名
        sret = sret + myinfo.Name + vbCrLf
        '//ファイルサイズ
        sret = sret + CStr(myinfo.size) + "バイト" + vbCrLf
        '//ファイルタイプ
        sret = sret + myinfo.Type + vbCrLf
        '//ファイル作成日時・最終アクセス日時・最終更新日時
        sret = sret + "作成日時    :" + DateFormat(myinfo.DateCreated) + vbCrLf
        sret = sret + "最終アクセス日時:" + DateFormat(myinfo.DateLastAccessed) + vbCrLf
        sret = sret + "最終更新日時  :" + DateFormat(myinfo.DateLastModified) + vbCrLf
        '//フォルダ作成日時・最終アクセス日時・最終更新日時
        sret = sret + "【Folder】" + vbCrLf
        sret = sret + "作成日時    :" + DateFormat(myinfo.ParentFolder.DateCreated) + vbCrLf
        sret = sret + "最終アクセス日時:" + DateFormat(myinfo.ParentFolder.DateLastAccessed) + vbCrLf
        sret = sret + "最終更新日時  :" + DateFormat(myinfo.ParentFolder.DateLastModified) + vbCrLf

        MsgBox sret, vbInformation
    lblerror:
        Set myinfo = Nothing
        Set myfso = Nothing
    End Sub

     

    '********************************************
    'Date型の書式を設定する
    '********************************************

    Private Function DateFormat(ByVal dt As Date) As String
        DateFormat = Format(dt, "yyyy-mm-dd hh:nn:ss")
    End Function

     

    '********************************************
    '指定位置から指定サイズ切り出して保存する
    '********************************************

    Public Sub バイナリファイルから指定サイズ切り出す()
        On Error GoTo lblerror
        Dim readfile As String, writefile As String
        Dim rfl As Long, lidx As Long, wfl As Long

        '//切り出す開始位置とサイズ
        '//アドレス0xC350(50000)から10000バイト切り出す
        Dim myichi As Long
        myichi = 0
        Dim mysize As Long
        mysize = 2910731

        '//ファイル指定
        readfile = ThisWorkbook.Path + "¥testpicture.jpg"
        writefile = ThisWorkbook.Path + "¥testbinary.bin"

        '//バッファ
        Dim rbuf() As Byte
        Dim wbuf() As Byte

        '//ファイルを開く
        rfl = FreeFile
        Open readfile For Binary Access Read As rfl
        '//書き込みファイルが存在する場合は中身をいったんクリアする
        wfl = FreeFile
        If Dir(writefile) <> "" Then
            Open writefile For Output As wfl
            Close (wfl)
        End If
        Open writefile For Binary Access Write As wfl
        '//読み込み
        ReDim rbuf(LOF(rfl))
        Get rfl, , rbuf

        '//書き込み
        ReDim wbuf(mysize)
        For lidx = 0 To LOF(rfl) - 1
            If lidx < myichi Then GoTo nextbyte
            If lidx > (myichi + mysize - 1) Then Exit For

            Put wfl, , rbuf(lidx)
    nextbyte:
        Next
        
        Close rfl
        Close wfl
        Exit Sub

    lblerror:
        MsgBox "何かエラーが発生しました", vbCritical
    End Sub

     

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


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



    selected entries

    categories

    calendar

    S M T W T F S
     123456
    78910111213
    14151617181920
    21222324252627
    28293031   
    << July 2019 >>

    profile

    others

    archives