Excel VBA File Utility

Excel VBA File Utility

Excel VBA |

FileUtil.cls

Option Explicit

Private Const INVALID_FILENO As Integer = -1

' 処理対象のファイル名を保持
Private m_Filename  As String

' 処理中のファイル番号を保持
Private m_FileNo    As Integer
'
' 初期化
'
Private Sub Class_Initialize()
    
    Call setFileNo(INVALID_FILENO)

End Sub

'
' 終了処理
'
Private Sub Class_Terminate()

    Call closeFile

End Sub
'
' ファイルが開かれているか
'
' @return 開かれていれば True
'
Public Function isOpen() As Boolean

    isOpen = (getFileNo > 0)

End Function
'
' ファイルを開く
'
' @param fileName
' @param mode
' @return 成功した場合True
'
Public Function openFile(fileName As String, mode As FileMode) As Boolean
    On Error GoTo errHandler
    openFile = True
    Call setFilename(fileName)
    Call setFileNo(FreeFile)
    
    Select Case mode
        Case FileMode.InputMode
            Open getFilename For Input As getFileNo
            
        Case FileMode.OutputMode
            Open getFilename For Output As getFileNo
        
        Case FileMode.AppendMode
            Open getFilename For Append As getFileNo
            
        Case Else
            openFile = False
    End Select
    
    Exit Function
errHandler:
    openFile = False
End Function
'
' ファイルから1行読込む
'
' @param line 読み込んだ行を格納
' @return データがこれ以上ない場合False
'
Public Function readLine(ByRef line As String) As Boolean
        
    Dim ret As Boolean
    
    ret = Not isEOF()
    
    If ret Then
        Line Input #getFileNo(), line
    End If
    
    readLine = ret
    
End Function
'
' ファイルがEOFに達しているか
'
' @return ファイルがEOFに達している場合True
'
Public Function isEOF() As Boolean

    isEOF = EOF(getFileNo())
    
End Function
'
' 出力(改行しない)
'
' @param str 出力内容
'
Public Sub print_(str As String)

    Print #getFileNo(), str;

End Sub
'
' 1行出力
'
' @param str 出力内容
'
Public Sub println(str As String)

    Print #getFileNo(), str

End Sub
'
' ファイルを閉じる
'
Public Sub closeFile()
    
    Close getFileNo()

End Sub

'
' ファイル名の設定
'
' @param newFileName
'
'
Private Sub setFilename(newFileName As String)

    m_Filename = newFileName

End Sub
'
' ファイル名の取得
'
' @param ファイル名
'
Public Function getFilename() As String

    getFilename = m_Filename

End Function
'
' ファイルNoの設定
'
' @param ファイルNo
'
Private Sub setFileNo(newFileNo As Integer)

    m_FileNo = newFileNo

End Sub
'
' ファイルNoの取得
'
' @return ファイルNo
'
Public Function getFileNo() As Integer

    getFileNo = m_FileNo

End Function

標準モジュールに

'----------------
'ファイルモード
'----------------
Public Enum FileMode
    InputMode = &H1&
    OutputMode = &H2&
    AppendMode = &H3&
End Enum

UTF-8 に対応

Option Explicit
'********************************************
'
'
'     ファイルユーティリティクラス
'       File関連のオブジェクト(ADODB.Stream)をラップ
'
'
'       @see https://docs.microsoft.com/ja-jp/office/client-developer/access/desktop-database-reference/stream-object-ado
'
'
'********************************************

Private Const INVALID_FILENO As Integer = -1

Private stream As Object

Private Const adTypeText = 2

Private Const adModeRead = 1
Private Const admodewrite = 2
Private Const adModeReadWrite = 3

Private Const adStateClosed = 0
Private Const adReadLine = -2
Private Const adCR = 13
Private Const adSaveCreateOverWrite = 2

' 処理対象のファイル名を保持
Private m_Filename  As String

' 処理中のファイル番号を保持
Private m_FileNo    As Integer

Private m_FileMode As FileMode


'
' 初期化
'
Private Sub Class_Initialize()
    
    Set stream = CreateObject("ADODB.Stream")
    
    'Call setFileNo(INVALID_FILENO)

End Sub

'
' 終了処理
'
Private Sub Class_Terminate()

    Call closeFile

    Set stream = Nothing

End Sub
'
' ファイルが開かれているか
'
Public Function isOpen() As Boolean
    ' https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/state-property-ado?view=sql-server-ver15
    'isOpen = (getFileNo > 0)
    
    isOpen = (stream.State <> adStateClosed)

End Function
'
' ファイルを開く
'
Public Function openFile(fileName As String, mode As FileMode) As Boolean
    On Error GoTo errHandler
    
    Dim isAppend As Boolean
    
    isAppend = False
    openFile = True
    
    stream.Charset = CHAR_SET
    stream.Type = adTypeText
    
    'https://docs.microsoft.com/ja-jp/office/client-developer/access/desktop-database-reference/lineseparator-property-ado
    stream.LineSeparator = adCR
    
    Call setFilename(fileName)
    'Call setFileNo(FreeFile)
    m_FileMode = mode
    
    Select Case mode
        Case FileMode.InputMode
            'Open getFilename For Input As getFileNo
            stream.mode = adModeReadWrite
            stream.Open
            stream.LoadFromFile fileName
            
        Case FileMode.OutputMode
            'Open getFilename For Output As getFileNo
            stream.mode = adModeReadWrite
            stream.Position = 0
            stream.Open
        Case FileMode.AppendMode
            'Open getFilename For Append As getFileNo
             stream.mode = adModeReadWrite
             'stream.SetEOS = True
            stream.Open
        Case Else
            openFile = False
    End Select
    
    Exit Function
errHandler:
    openFile = False
    Debug.Print Err.Number & ":" & Err.Description
    
End Function
'
' ファイルから1行読込む
'
Public Function readLine(ByRef line As String) As Boolean
        
    Dim ret As Boolean
    
    ret = Not isEOF()
    
    If ret Then
        'Line Input #getFileNo(), line
        
        line = stream.ReadText(adReadLine)
        
    End If
    
    readLine = ret
    
End Function
'
' ファイルがEOFに達しているか
'
Public Function isEOF() As Boolean

    'isEOF = EOF(getFileNo())
    isEOF = stream.EOS
    
End Function
'
' 1行出力
'
Public Sub println(str As String)

    'Print #getFileNo(), str
    stream.writeText str
    
    
End Sub
'
' ファイルを閉じる
'
Public Sub closeFile()
    
    'Close getFileNo()
    If isOpen() Then
    
        
        Select Case m_FileMode
            Case FileMode.InputMode
                
            Case FileMode.OutputMode
                Call stream.SaveToFile(m_Filename, adSaveCreateOverWrite)
            Case FileMode.AppendMode
                Call stream.SaveToFile(m_Filename, adSaveCreateOverWrite)
            Case Else
        End Select
    
    
        stream.Close
    End If

End Sub

'
' ファイル名の設定
'
Private Sub setFilename(newVal As String)

    m_Filename = newVal

End Sub
'
' ファイル名の取得
'
Public Function getFilename() As String

    getFilename = m_Filename

End Function
'
' ファイルNoの設定
'
Private Sub setFileNo(newVal As Integer)

    m_FileNo = newVal

End Sub
'
' ファイルNoの取得
'
Public Function getFileNo() As Integer

    getFileNo = m_FileNo

End Function

テンプレート:Ref FileUtil.cls