textboxに””を入れる場合。。。。 (ID:111378)

名前

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

本文

…すいません、私が知っているバイナリでの方法だと大体こんな感じです。
もっと簡単なのがあると思いますが…すみません、忘れました。
新しいクラスに貼り付けてください作成してください。

'■■■Class1に、ここから
'Binary で文字列をReadWriteするクラス
Option Explicit

Private UsingFileName           As String

Private Sub Class_Initialize()
UsingFileName = vbNullString
End Sub

Public Property Get ReadWriteStream_FileName() As String
ReadWriteStream_FileName = UsingFileName
End Property

Public Property Let ReadWriteStream_FileName(ByVal NewValue As String)
UsingFileName = NewValue
End Property

Public Function ReadAll(ByRef return_StringArray() As Variant) As Long

Dim i               As Long
Dim ff              As Long
Dim buf()           As Byte
Dim bufLength       As Long

If UsingFileName <> vbNullString Then
    
    ff = FreeFile()
    Open UsingFileName For Binary As ff
        
        Get #ff, 1, ReadAll
        
        If ReadAll > 0 Then
            
            ReDim return_StringArray(1 To ReadAll)
            
            For i = 1 To ReadAll
                
                Get #ff, , bufLength
                
                If bufLength > 0 Then
                    ReDim buf(1 To bufLength)
                    Get #ff, , buf
                    return_StringArray(i) = buf
                End If
                
            Next
            
        End If
        
    Close ff
    
Else
    ReadAll = 0
End If

End Function

Public Function WriteAll(ByRef write_StringArray() As Variant) As Long

Dim i               As Long
Dim ff              As Long
Dim buf()           As Byte
Dim bufLength       As Long

On Error GoTo WriteAll_Error:
WriteAll = UBound(write_StringArray) - LBound(write_StringArray) + 1
On Error GoTo 0

If UsingFileName <> vbNullString Then
    
    On Error Resume Next
    SetAttr UsingFileName, vbArchive
    Kill UsingFileName
    On Error GoTo 0
    
    ff = FreeFile()
    Open UsingFileName For Binary As ff
        
        Put #ff, 1, WriteAll
        
        For i = LBound(write_StringArray) To UBound(write_StringArray)
            
            If write_StringArray(i) = vbNullString Then
                Put #ff, , 0&
            Else
                buf = CStr(write_StringArray(i))
                bufLength = UBound(buf) - LBound(buf) + 1
                Put #ff, , bufLength
                Put #ff, , buf
            End If
            
        Next
        
    Close ff
    
Else
    WriteAll = 0
End If

Exit Function

WriteAll_Error:
'エラーの場合は抜ける
WriteAll = 0
On Error GoTo 0

End Function
'■■■ここまで貼り付ける

以下はフォームにでも貼り付ける。
'■■■利用例
Public Sub main()
Dim x As New BinaryReadWriteClass
Dim va() As Variant
Dim v As Variant
va = Array("1: abcdefg" + """" + "abc" + """", _
           "2: " + vbTab + """" + "this is tab." + """")
x.ReadWriteStream_FileName = "c:\1.bin"
x.WriteAll va
Erase va
x.ReadAll va
For Each v In va
    MsgBox v
Next
End Sub

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

戻る