ユーザー定義型をファイルに書き込み (ID:100583)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

こんにちは。
バイナリ用サンプルです。
標準モジュールに

'ユーザー定義型 書込み用
Public Type DataType
    Midasi As String * 10   '見出し
    Name   As String * 15   '氏名
    CrLf   As String * 2    '改行コード  必要なければCut
End Type

'ユーザー定義型 読出し用
Public Type ByteType
    Midasib(9)  As Byte
    Nameb(14)   As Byte
    CrLf(1)     As Byte     '改行コード  必要なければCut
End Type

フォームモジュールに
Option Explicit

' 書込み
Private Sub Command1_Click()
    Dim Tbl         As DataType
    Dim intFileNo   As Integer
    Dim strFileName As String
    
    strFileName = "D:\BinTest.bin"
    On Error Resume Next
    Kill strFileName    '書込みファイルがあった場合削除
    On Error GoTo 0
    
    With frmMain
        Tbl.Midasi = strLenChk(.txtMidasi.Text, 10)
        Tbl.Name = strLenChk(.txtName.Text, 15)
        Tbl.CrLf = vbCrLf           ' 必要ない場合は Cut
    End With
    
    intFileNo = FreeFile
    Open strFileName For Binary Access Write As #intFileNo
        ' ファイルに書込み  同じことを２回行っています。
        Put #intFileNo, , Tbl
        Put #intFileNo, , Tbl
    Close #intFileNo
End Sub

' 読出し
Private Sub Command2_Click()
    Dim TblB        As ByteType
    Dim intFileNo   As Integer
    Dim strFileName As String
    Dim lngE        As Long
    
    strFileName = "D:\BinTest.bin"
    intFileNo = FreeFile
    Open strFileName For Binary Access Read As #intFileNo
        Do While lngE < LOF(intFileNo)
            Get #intFileNo, , TblB
            lngE = Loc(intFileNo)
            Debug.Print StrConv(TblB.Midasib, vbUnicode), _
                        StrConv(TblB.Nameb, vbUnicode)
        Loop
    Close #intFileNo
End Sub

Private Sub Form_Load()
    frmMain.txtMidasi.Text = "定義型123あいう"  '10 Byte Over させています。
    frmMain.txtName.Text = "山田太郎"
End Sub

' 長さチェック  長い場合は長さでカット
Private Function strLenChk(strM As String, BytNum As Long) As String
    Dim Act As String
    Act = StrConv(LeftB(StrConv(strM, vbFromUnicode), BytNum), vbUnicode)
    If InStr(1, Act, vbNullChar) > 0 Then Act = Left(Act, Len(Act) - 1)
    strLenChk = Act
End Function

←解決時は質問者本人がここをチェックしてください。

戻る