テキストファイル：データを書き込む（Put ステートメント）

サイト管理人

9年前

Put ステートメント

Open ステートメントをランダムアクセスモード（Random）または、バイナリモード（Binary）で開いたファイルにデータを書き込みます。

【構文】

Put #filenumber, [ recnumber ], varname

引数・戻り値

filenumber  ・・・  Open ステートメントで、割り当てられたファイル番号を指定します。

recnumber  ・・・  ランダムアクセスモード（Random）の場合、書き込みが開始される場所のレコード番号、バイナリモード（Binary）の場合、書き込みが開始される場所のバイト番号を指定します（省略可）。

varname  ・・・  データを書き込む内容または、そのデータが含まれる変数の名前を指定します（省略不可）。

ファイル内の最初のレコードまたはバイトの位置は 位置 1、次のレコードまたはバイトの位置は 位置 2 となり、これ以降も同様です。引数 recnumber を省略すると、最後の Get か Put ステートメントの次のレコード（バイト）、または最後の Seek 関数によって指定された位置の次のレコード（バイト）にデータが書き込まれます。省略する場合には、区切り文字のカンマ（,）を含める必要があります。

Random モードで開いたファイルの場合、一般に、レコード長は、書き込まれるデータの長さに一致させます。書き込まれるデータの長さが、Open ステートメントの Len 句に指定された長さよりも短い場合、Put により、以降のレコードがレコード長境界に書き込まれます。書き込まれるデータの長さが Open ステートメントの Len 句に指定された長さよりも長い場合、エラーが発生します。

通常、Put ステートメントによって書き込まれるデータは、Get ステートメントによってファイルから読み取られます。

Put ステートメント使用例

サンプルVBAソース 1

　
Sub Sample_Put_Binary1()

    'ファイルに、データを書き込む
    '（Binary モード ／ Put # ステートメント）

    Dim FileName As String
    Dim FNum As Integer
    Dim Var(2) As String
    Dim i As Integer
    
    FileName = "C:\Documents\mydata\test01.txt"
    FNum = FreeFile     'ファイル番号取得
    
    Var(0) = "abcde"
    Var(1) = String(3, "S")
    Var(2) = "これはテストです。"
    
    '同じ名前のファイルが存在している場合はそのファイルを削除
    If Dir(FileName) <> "" Then
        Kill FileName
    End If
        
    '新規ファイルを開く（Binary モード）
    Open FileName For Binary As #FNum
    
    'データを書き込む
    
    For i = 0 To 2
        
        Put #FNum, , Var(i) & vbCrLf
    
    Next i
    
    Put #FNum, , vbTab
    Put #FNum, , "1234567890"
    Put #FNum, , vbCrLf
    Put #FNum, 40, "Write  record to file."
    Put #FNum, 45, vbCrLf
        
    'ファイルを閉じる
    Close #FNum
    
End Sub

Sub Sample_Put_Binary1()

'ファイルに、データを書き込む

'（Binary モード／ Put # ステートメント）

Dim FileName As String

Dim FNum As Integer

Dim Var(2) As String

Dim i As Integer

FileName = "C:\Documents\mydata\test01.txt"

FNum = FreeFile 'ファイル番号取得

Var(0) = "abcde"

Var(1) = String(3, "S")

Var(2) = "これはテストです。"

'同じ名前のファイルが存在している場合はそのファイルを削除

If Dir(FileName) <> "" Then

Kill FileName

End If

'新規ファイルを開く（Binary モード）

Open FileName For Binary As #FNum

'データを書き込む

For i = 0 To 2

Put #FNum, , Var(i) & vbCrLf

Next i

Put #FNum, , vbTab

Put #FNum, , "1234567890"

Put #FNum, , vbCrLf

Put #FNum, 40, "Write record to file."

Put #FNum, 45, vbCrLf

'ファイルを閉じる

Close #FNum

End Sub

サンプルVBAソース 1 実行結果

サンプルVBAソース 1 を実行して作成されたファイルの内容

サンプルVBAソース 2

　
Sub Sample_Put_Binary2()

    'ファイルに、データを追加で、書き込む
    '（Binary モード ／ Put # ステートメント）

    Dim FileName As String
    Dim FNum As Integer
    Dim strDate As String
    
    FileName = "C:\Documents\mydata\test01.txt"
    FNum = FreeFile     'ファイル番号取得
    strDate = Format(Date, "dddddd")
    
    'ファイルを開く（Binary モード）
    Open FileName For Binary As #FNum
    
    'データを追加で書き込む
    
    Put #FNum, LOF(FNum), vbCrLf
    Put #FNum, , "データを追加します。"
    Put #FNum, , vbCrLf
    Put #FNum, , strDate

    'ファイルを閉じる
    Close #FNum

End Sub

Sub Sample_Put_Binary2()

'ファイルに、データを追加で、書き込む

'（Binary モード／ Put # ステートメント）

Dim FileName As String

Dim FNum As Integer

Dim strDate As String

FileName = "C:\Documents\mydata\test01.txt"

FNum = FreeFile 'ファイル番号取得

strDate = Format(Date, "dddddd")

'ファイルを開く（Binary モード）

Open FileName For Binary As #FNum

'データを追加で書き込む

Put #FNum, LOF(FNum), vbCrLf

Put #FNum, , "データを追加します。"

Put #FNum, , vbCrLf

Put #FNum, , strDate

'ファイルを閉じる

Close #FNum

End Sub

サンプルVBAソース 2 実行結果

サンプルVBAソース 2 を実行して作成されたファイルの内容

サンプルVBAソース 3

　
Type Record

    ID As Integer
    Name As String * 20
    RDate As Date

End Type
　
---------------------------------------------------------------------------------------------
　
Sub Sample_Put_Random()
    
    'ファイルにデータを書き込む
    '（Random モード ／ Put ステートメント）
    
    Dim myRecord As Record
    Dim FileName As String
    Dim FNum As Integer
    Dim w As Worksheet
    Dim myRng As Range
    Dim i As Integer
    
    FileName = "C:\Documents\mydata\test02.txt"
    FNum = FreeFile
    
    'ファイルが存在する場合は削除
    If Dir(FileName) <> "" Then
        Kill FileName
    End If
    
    Set w = Worksheets("Sheet1")
    Set myRng = w.Range("A1").CurrentRegion
    
    'ファイルを開く（Random
    Open FileName For Random As #FNum Len = Len(myRecord)
    
    '「シート1」のデータを書き込む
    For i = 2 To myRng.Rows.Count
        With myRecord
            .ID = myRng(i, 1).Value
            .Name = myRng(i, 2).Value
            .RDate = myRng(i, 3).Value
        End With
        
        Put #FNum, i - 1, myRecord
    Next i
    
    Close #FNum
    
    
    '書き込んだ内容を表示（Get ステートメントで取得）
    
    Dim strRecord
    
    Open FileName For Random As #FNum Len = Len(myRecord)
    
    Do Until EOF(FNum)
        Get #FNum, , myRecord
        With myRecord
            If .ID > 0 Then
                strRecord = strRecord & vbCrLf & _
                            .ID & vbTab & .Name & vbTab & .RDate
            End If
        End With
    Loop
    
    Close #FNum
    
    MsgBox strRecord

End Sub

Type Record

ID As Integer

Name As String * 20

RDate As Date

End Type

---------------------------------------------------------------------------------------------

Sub Sample_Put_Random()

'ファイルにデータを書き込む

'（Random モード／ Put ステートメント）

Dim myRecord As Record

Dim FileName As String

Dim FNum As Integer

Dim w As Worksheet

Dim myRng As Range

Dim i As Integer

FileName = "C:\Documents\mydata\test02.txt"

FNum = FreeFile

'ファイルが存在する場合は削除

If Dir(FileName) <> "" Then

Kill FileName

End If

Set w = Worksheets("Sheet1")

Set myRng = w.Range("A1").CurrentRegion

'ファイルを開く（Random

Open FileName For Random As #FNum Len = Len(myRecord)

'「シート1」のデータを書き込む

For i = 2 To myRng.Rows.Count

With myRecord

.ID = myRng(i, 1).Value

.Name = myRng(i, 2).Value

.RDate = myRng(i, 3).Value

End With

Put #FNum, i - 1, myRecord

Next i

Close #FNum

'書き込んだ内容を表示（Get ステートメントで取得）

Dim strRecord

Open FileName For Random As #FNum Len = Len(myRecord)

Do Until EOF(FNum)

Get #FNum, , myRecord

With myRecord

If .ID > 0 Then

strRecord = strRecord & vbCrLf & _

.ID & vbTab & .Name & vbTab & .RDate

End If

End With

Loop

Close #FNum

MsgBox strRecord

End Sub

Put ステートメント

Put ステートメント 使用例

サンプルVBAソース 1

サンプルVBAソース 1 実行結果

サンプルVBAソース 2

サンプルVBAソース 2 実行結果

サンプルVBAソース 3

サンプルVBAソース 3 実行結果

Put ステートメント使用例