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

<機能>

(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

 

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


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



<< | 3/61PAGES | >>

selected entries

categories

calendar

S M T W T F S
      1
2345678
9101112131415
16171819202122
23242526272829
30      
<< June 2019 >>

profile

others

archives