ブログ

このエントリーをはてなブックマークに追加
サイト管理人のブログです。

ブログ一覧

エクセルVBAでCSVファイル、固定長ファイルの入出力

ひさしぶりの更新。ものすごく前に作成したエクセルVBA用に作成したモジュールをみつけた。せっかくなので公開しようと思う。機能としてはCSVファイルのインプット、アウトプット、固定長ファイルのインプット、アウトプット。ファイルは以下の5つ。

  • basConstForFileIO
  • clsMakeCSV
  • clsMakeFixedLenValue
  • clsReadCSV
  • clsReadFixedLenValue

basConstForFileIO.bas

これは共通定数。以下ソース。

' -----------------------------------------------
' 共通
' -----------------------------------------------
' ファイルシステムオブジェクト用
Public Const FILEOPEN_FORREADING = 1
Public Const FILEOPEN_FORWRITING = 2
Public Const FILEOPEN_FORAPPENDING = 8

' エラーコード
Public Const NORMAL_FILEOPEN = 0
Public Const ERROR_FILEOPEN = -1
Public Const ERROR_FILENOTFOUND = -2

' 改行コード
Public Enum ReturnCode
    retCR = 1                           ' キャリッジリターン
    retLF = 2                           ' ラインフィールド
    retCRLF = 3                         ' キャリッジリターン + ラインフィールド
End Enum

' -----------------------------------------------
' CSVファイル
' -----------------------------------------------
' CSVファイル用列挙型
Public Enum CsvValueType
    csvDefault = &H0                    ' デフォルト値を使用
    csvNormal = &H1                     ' 値をそのまま出力
    csvWithDblQuote = &H2               ' ダブルクォート付き
    csvWithSglQuote = &H4               ' シングルクォート付き
    csvToWide = &H8                     ' 全角変換
    csvToNarrow = &H10                  ' 半角変換
End Enum

' -----------------------------------------------
' 固定長ファイル
' -----------------------------------------------
' 固定長ファイル用列挙型
Public Enum FixedValueType
    fixlenDefault = &H0                 ' デフォルト値を使用
    fixlenAlignLeft = &H1               ' 左詰め
    fixlenAlignRight = &H2              ' 右詰め
    fixlenToWide = &H4                  ' 全角変換
    fixlenToNarrow = &H8                ' 半角変換
    fixlenWithNarrowSpace = &H10        ' 半角スペース埋め
    fixlenWithWideSpace = &H20          ' 全角スペース埋め
    fixlenWithZero = &H40               ' 0(半角)埋め
End Enum

clsMakeCSV.cls

これはCSVファイル作成クラス。以下ソース。

Private m_objFS             As Object           ' ファイルシステムオブジェクト
Private m_objMakeFile       As Object           ' CSVファイルオブジェクト
Private m_strFilePath       As String           ' CSVファイルパス
Private m_strValue          As String           ' 出力する1行分の文字列
Private m_enmDefaultDeco    As CsvValueType     ' CSV値タイプ
Private m_strRetCode        As String           ' 改行文字

' Class_Initialize
'
' #コンストラクタ
'
Private Sub Class_Initialize()

    ' 初期化
    Set m_objFS = CreateObject("Scripting.FileSystemObject")
    m_enmDefaultDeco = csvNormal    ' 初期値はそのまま値を出力とする
    m_strValue = ""
    m_strRetCode = vbCrLf           ' デフォルトの改行コード
    
End Sub

' FilePath
'
' #ファイルパスの設定
'   @param  Path    ファイルパス
'
Public Function SetFilePath(ByVal Path As String) As Long

    m_strFilePath = Path

    On Error Resume Next
    Set m_objMakeFile = m_objFS.OpenTextFile(m_strFilePath, FILEOPEN_FORWRITING, True)
    If Err.Number <> 0 Then
    ' ファイルオープンエラー時
        SetFilePath = ERROR_FILEOPEN
        Exit Function
    End If
    On Error GoTo 0
    
    SetFilePath = NORMAL_FILEOPEN
    
End Function

' ReturnCode
'
' #改行コードの設定
'   @param  RetCode     改行コード(列挙型)
'
Public Property Let ReturnCode(ByVal RetCode As ReturnCode)

    Select Case RetCode
        Case retCR
        ' キャリッジリターン
            m_strRetCode = vbCr
            
        Case retLF
        ' ラインフィールド
            m_strRetCode = vbLf
            
        Case retCRLF
        ' キャリッジリターン + ラインフィールド
            m_strRetCode = vbCrLf
            
        Case Else
        
    End Select

End Property

' Decoration
'
' #値の装飾デフォルト値の変更
'   @param  Deco        値の装飾設定
'
Public Property Let Decoration(ByVal Deco As CsvValueType)

    m_enmDefaultDeco = Deco        ' 値の装飾デフォルト値変更
    
End Property

' AddValue
'
' #値の追加(カンマ区切りの1項目)
'   @param  value   値
'   @param  deco    デフォルトの装飾
'
Public Sub AddValue(ByVal Value As String, Optional ByVal Deco As CsvValueType = csvDefault)
        
    Dim enmDeco         As CsvValueType
    Dim strMakeValue    As String
    
    ' ダブルクォート設定
    If Deco = csvDefault Then
        ' デフォルト値の場合、もしくは引数省略の場合
        enmDeco = m_enmDefaultDeco
    Else
        ' 引数指定の場合
        enmDeco = Deco
    End If
    
    ' CSV値を作成
    strMakeValue = Value
    
    ' 全角、半角設定
    If enmDeco And csvToWide Then
        strMakeValue = StrConv(strMakeValue, vbWide)
    ElseIf enmDeco And csvToNarrow Then
        strMakeValue = StrConv(strMakeValue, vbNarrow)
    End If
    
    ' 「"」→「""」
    strMakeValue = Replace(strMakeValue, Chr(&H22), Chr(&H22) & Chr(&H22))
    
    ' 装飾設定
    If enmDeco And csvWithDblQuote Then
    ' ダブルクォート付き
        strMakeValue = Chr(&H22) & strMakeValue & Chr(&H22)
    ElseIf enmDeco And csvWithSglQuote Then
    ' シングルクォート付き
        strMakeValue = Chr(&H27) & strMakeValue & Chr(&H27)
    End If
    
    ' 値追加
    If m_strValue = "" Then
        ' 最初の場合
        m_strValue = strMakeValue
    Else
        ' 2項目以降
        m_strValue = m_strValue & "," & strMakeValue
    End If
    
End Sub

' NextLine
'
' #1ラインの書き込み
'
Public Sub NextLine()
    
    m_objMakeFile.Write m_strValue & m_strRetCode        ' 値 + 改行コード
    m_strValue = ""

End Sub

' Class_Terminate
'
' #デストラクタ
'
Private Sub Class_Terminate()

    On Error Resume Next
    
    ' すべてのオブジェクト破棄
    m_objMakeFile.Close
    Set m_objMakeFile = Nothing
    Set m_objFS = Nothing
    
    On Error GoTo 0

End Sub

clsMakeFixedLenValue.cls

これは固定長ファイル作成クラス。以下ソース。

Private m_objFS             As Object           ' ファイルシステムオブジェクト
Private m_objMakeFile       As Object           ' CSVファイルオブジェクト
Private m_strFilePath       As String           ' CSVファイルパス
Private m_strValue          As String           ' 出力する1行分の文字列
Private m_enmDefaultDeco    As CsvValueType     ' CSV値タイプ
Private m_strRetCode        As String           ' 改行文字

' Class_Initialize
'
' #コンストラクタ
'
Private Sub Class_Initialize()

    ' 初期化
    Set m_objFS = CreateObject("Scripting.FileSystemObject")
    m_enmDefaultDeco = csvNormal    ' 初期値はそのまま値を出力とする
    m_strValue = ""
    m_strRetCode = vbCrLf           ' デフォルトの改行コード
    
End Sub

' FilePath
'
' #ファイルパスの設定
'   @param  Path    ファイルパス
'
Public Function SetFilePath(ByVal Path As String) As Long

    m_strFilePath = Path

    On Error Resume Next
    Set m_objMakeFile = m_objFS.OpenTextFile(m_strFilePath, FILEOPEN_FORWRITING, True)
    If Err.Number <> 0 Then
    ' ファイルオープンエラー時
        SetFilePath = ERROR_FILEOPEN
        Exit Function
    End If
    On Error GoTo 0
    
    SetFilePath = NORMAL_FILEOPEN
    
End Function

' ReturnCode
'
' #改行コードの設定
'   @param  RetCode     改行コード(列挙型)
'
Public Property Let ReturnCode(ByVal RetCode As ReturnCode)

    Select Case RetCode
        Case retCR
        ' キャリッジリターン
            m_strRetCode = vbCr
            
        Case retLF
        ' ラインフィールド
            m_strRetCode = vbLf
            
        Case retCRLF
        ' キャリッジリターン + ラインフィールド
            m_strRetCode = vbCrLf
            
        Case Else
        
    End Select

End Property

' Decoration
'
' #値の装飾デフォルト値の変更
'   @param  Deco        値の装飾設定
'
Public Property Let Decoration(ByVal Deco As CsvValueType)

    m_enmDefaultDeco = Deco        ' 値の装飾デフォルト値変更
    
End Property

' AddValue
'
' #値の追加(カンマ区切りの1項目)
'   @param  value   値
'   @param  deco    デフォルトの装飾
'
Public Sub AddValue(ByVal Value As String, Optional ByVal Deco As CsvValueType = csvDefault)
        
    Dim enmDeco         As CsvValueType
    Dim strMakeValue    As String
    
    ' ダブルクォート設定
    If Deco = csvDefault Then
        ' デフォルト値の場合、もしくは引数省略の場合
        enmDeco = m_enmDefaultDeco
    Else
        ' 引数指定の場合
        enmDeco = Deco
    End If
    
    ' CSV値を作成
    strMakeValue = Value
    
    ' 全角、半角設定
    If enmDeco And csvToWide Then
        strMakeValue = StrConv(strMakeValue, vbWide)
    ElseIf enmDeco And csvToNarrow Then
        strMakeValue = StrConv(strMakeValue, vbNarrow)
    End If
    
    ' 「"」→「""」
    strMakeValue = Replace(strMakeValue, Chr(&H22), Chr(&H22) & Chr(&H22))
    
    ' 装飾設定
    If enmDeco And csvWithDblQuote Then
    ' ダブルクォート付き
        strMakeValue = Chr(&H22) & strMakeValue & Chr(&H22)
    ElseIf enmDeco And csvWithSglQuote Then
    ' シングルクォート付き
        strMakeValue = Chr(&H27) & strMakeValue & Chr(&H27)
    End If
    
    ' 値追加
    If m_strValue = "" Then
        ' 最初の場合
        m_strValue = strMakeValue
    Else
        ' 2項目以降
        m_strValue = m_strValue & "," & strMakeValue
    End If
    
End Sub

' NextLine
'
' #1ラインの書き込み
'
Public Sub NextLine()
    
    m_objMakeFile.Write m_strValue & m_strRetCode        ' 値 + 改行コード
    m_strValue = ""

End Sub

' Class_Terminate
'
' #デストラクタ
'
Private Sub Class_Terminate()

    On Error Resume Next
    
    ' すべてのオブジェクト破棄
    m_objMakeFile.Close
    Set m_objMakeFile = Nothing
    Set m_objFS = Nothing
    
    On Error GoTo 0

End Sub

clsReadCSV.cls

これはCSV読み込みクラス。以下ソース。

Private m_objFS                 As Object               ' ファイルシステムオブジェクト
Private m_objReadFile           As Object               ' CSVファイルオブジェクト
Private m_strFilePath           As String               ' CSVファイルパス
Private m_strOneLineString      As String               ' 1行分の文字列
Private m_colIndex              As New Collection       ' 設定フィールド
Private m_blnEndOfStream        As Boolean              ' EOFプロパティ
Private m_lngLineCount          As Long                 ' 行数
Private m_intItemCount          As Integer              ' 1行分のアイテムカウント
Private m_strRetCode            As String               ' 改行文字

' Class_Initialize
'
' #コンストラクタ
'
Private Sub Class_Initialize()

    ' 初期化
    Set m_objFS = CreateObject("Scripting.FileSystemObject")
    m_lngLineCount = 1
    m_strRetCode = vbCrLf          ' デフォルトの改行コード
    
End Sub

' SetFilePath
'
' #ファイルパスの設定
'   @param  Path    ファイルパス
'   @return エラーコード
'
Public Function SetFilePath(ByVal Path As String) As Long

    m_strFilePath = Path    ' CSVファイルパス設定

    ' ファイル存在チェック
    If Not m_objFS.FileExists(m_strFilePath) Then
    ' ファイル存在エラー
        SetFilePath = ERROR_FILENOTFOUND
        Exit Function
    End If

    On Error Resume Next
    Set m_objReadFile = m_objFS.OpenTextFile(m_strFilePath, FILEOPEN_FORREADING, False)   '  CSVファイルオブジェクト作成
    If Err.Number <> 0 Then
    ' ファイルオープンエラー
        SetFilePath = ERROR_FILEOPEN
        Exit Function
    End If
    On Error GoTo 0
    
    If m_objReadFile.AtEndOfStream Then
        m_blnEndOfStream = True
    Else
        m_strOneLineString = m_GetLineString
        m_blnEndOfStream = False
    End If
    
    SetFilePath = NORMAL_FILEOPEN
    
End Function

' ReturnCode
'
' #改行コードの設定
'   @param  RetCode     改行コード(列挙型)
'
Public Property Let ReturnCode(ByVal RetCode As ReturnCode)

    Select Case RetCode
        Case retCR
        ' キャリッジリターン
            m_strRetCode = vbCr
            
        Case retLF
        ' ラインフィールド
            m_strRetCode = vbLf
            
        Case retCRLF
        ' キャリッジリターン + ラインフィールド
            m_strRetCode = vbCrLf
            
        Case Else
        
    End Select

End Property

' HasNext
'
' #次のラインが存在するか判別
'   @return     True    存在する
'               False   存在しない
'
Public Property Get HasNext() As Boolean
      
    HasNext = Not m_blnEndOfStream

End Property

' SetValue
'
' #フィールドのセット
'   @param  fieldname   フィールド名
'   @param  index       インデックス
'
Public Sub SetValue(ByVal FieldName As String, ByVal Index As Integer)

    On Error Resume Next
    m_colIndex.Add Item:=CStr(Index), Key:=FieldName
    If Err.Number <> 0 Then
        MsgBox "フィールド名がセットできません。重複してないか確認してください。", vbExclamation
    End If
    On Error GoTo 0
    
End Sub

' GetOneLineString
'
' #1行分の文字列を返す
'   @return     1行分の文字列
'
Public Property Get GetOneLineString() As String

    GetOneLineString = m_strOneLineString

End Property

' GetValue
'
' #フィールド値を取得する
'   @param      field   フィールド名、もしくはインデックス(インデックスは1から)
'   @return     インデックス、もしくはフィールドに対応する文字列
'
Public Property Get GetValue(ByVal Field As Variant) As String

    Dim intItemIndex        As Integer

    ' 項目インデックスを取得
    If VarType(Field) = vbInteger Then
    ' 引数がインデックス指定の場合
        intItemIndex = Field
    Else
    ' 引数が設定したフィールド名の場合
        intItemIndex = CInt(m_colIndex.Item(Field))
    End If

    GetValue = m_GetCSVItemValue(intItemIndex)

End Property

' Line
'
' #現在行を取得
'   @return     現在行を返す
'
Public Property Get Line() As Long
        
    Line = m_lngLineCount

End Property

' NextLine
'
' #次の行に移動
'
Public Sub NextLine()
        
    If m_objReadFile.AtEndOfStream Then
        m_blnEndOfStream = True
    Else
'        m_strOneLineString = m_objReadFile.ReadLine
        m_strOneLineString = m_GetLineString
        m_blnEndOfStream = False
    End If

    m_lngLineCount = m_lngLineCount + 1

End Sub

' ReSet
'
' #ファイルをセットし直す
'   @param  なし
'   @return エラーコード
'
Public Function ReSetFile() As Long

    ' ファイルいったんクローズ
    m_objReadFile.Close
    Set m_objReadFile = Nothing

    ' ファイル存在チェック
    If Not m_objFS.FileExists(m_strFilePath) Then
    ' ファイル存在エラー
        ReSetFile = ERROR_FILENOTFOUND
        Exit Function
    End If

    On Error Resume Next
    Set m_objReadFile = m_objFS.OpenTextFile(m_strFilePath, FILEOPEN_FORREADING, False)   ' CSVファイルオブジェクト作成
    If Err.Number <> 0 Then
    ' ファイルオープンエラー
        ReSetFile = ERROR_FILEOPEN
        Exit Function
    End If
    
    If m_objReadFile.AtEndOfStream Then
        m_blnEndOfStream = True
    Else
        m_strOneLineString = m_GetLineString
        m_blnEndOfStream = False
    End If

    m_lngLineCount = 1

    ' 戻り値、正常コード
    ReSetFile = NORMAL_FILEOPEN

End Function

' m_GetLineString
'
' #1行分の文字列を返す
'   @param  なし
'   @return 1行分の文字列
'
Private Function m_GetLineString() As String
    
    Dim strLine     As String   ' 1行分文字列
    Dim strTmp1     As String   ' 改行コード判別用
    Dim strTmp2     As String   ' 改行コード判別用

    strLine = ""

    Do While Not m_objReadFile.AtEndOfStream
        strTmp1 = m_objReadFile.Read(1)         ' 1文字取得
        strTmp2 = ""
        
        ' 改行判定
        Select Case m_strRetCode
            Case vbCr
            ' キャリッジリターン
                If strTmp1 = vbCr Then
                    Exit Do
                End If
            
            Case vbLf
            ' ラインフィールド
                If strTmp1 = vbLf Then
                    Exit Do
                End If
            
            Case vbCrLf
            ' キャリッジリターン + キャリッジリターン
                If strTmp1 = vbCr Then
                    If Not m_objReadFile.AtEndOfStream Then
                        strTmp2 = m_objReadFile.Read(1)
                        If strTmp2 = vbLf Then
                        ' CRLFである
                            Exit Do
                        End If
                    End If
                End If
            Case Else
        End Select
        
        strLine = strLine & strTmp1 & strTmp2
    Loop

    m_GetLineString = strLine

End Function

' GetItemCount
'
' #カンマ区切りの項目数を返す
'   @return カンマ区切りの項目数
'
Public Property Get GetItemCount() As Integer

    Const CHARCODE_DOUBLEQUOTE = &H22

    Dim i                           As Integer
    Dim strOneStr                   As String
    Dim intItemCount                As Integer
    Dim blnFirstStrFlg              As Boolean      ' 項目の最初の文字か判別
    Dim blnDblQuoteOnFlg            As Boolean      ' 項目が「"」くくられているか判別
    Dim blnBeforStrDblQuoteFlg      As Boolean      ' 前の文字が「"」か判別
    
    ' 1行分の文字列が空なら終了
    If Len(m_strOneLineString) = 0 Then
        GetItemCount = 1
        Exit Property
    End If
    
    ' 初期化
    blnFirstStrFlg = True
    blnDblQuoteOnFlg = False
    blnBeforStrDblQuoteFlg = False
    intItemCount = 1
        
    For i = 0 To Len(m_strOneLineString) - 1
        strOneStr = Mid(m_strOneLineString, i + 1, 1)
        Select Case strOneStr
            Case Chr(CHARCODE_DOUBLEQUOTE)
            ' 「"」の場合
                If blnFirstStrFlg = True Then
                ' 項目の最初の文字の場合
                    blnDblQuoteOnFlg = True
                Else
                ' 2文字目以降の文字の場合
                    If blnDblQuoteOnFlg = True Then
                    ' 項目が「"」でくくられている場合
                        If blnBeforStrDblQuoteFlg = True Then
                        ' 前の文字が「"」の場合、エスケープされた「"」とみなす
                            blnBeforStrDblQuoteFlg = False
                        Else
                        ' 前の文字が「"」でない場合
                            blnBeforStrDblQuoteFlg = True
                        End If
                    Else
                    ' 項目が「"」でくくられてない場合
                    
                    End If
                End If
                blnFirstStrFlg = False
                
            Case ","
            '「,」の場合
                If blnDblQuoteOnFlg = False Or (blnDblQuoteOnFlg = True And blnBeforStrDblQuoteFlg = True) Then
                ' 「"」でくくられてない、または「"」でくくられていて前の文字が「"」である場合、セパレート文字とみなす。項目確定
                    ' 指定項目でないので初期化して次の項目へ
                    blnFirstStrFlg = True
                    blnDblQuoteOnFlg = False
                    blnBeforStrDblQuoteFlg = False
                    intItemCount = intItemCount + 1
                Else
                ' セパレート文字でなく文字の「,」とみなす
                    blnFirstStrFlg = False
                End If
                                 
            Case Else
            ' 上記以外の場合
                blnFirstStrFlg = False
                                              
        End Select
    Next i
    
    GetItemCount = intItemCount
    
End Property

' m_GetCSVItemValue
'
' #指定インデックスのCSVの値を求める
'   @param  ItemIndex       インデックス
'   @return 指定インデックスのCSVの値
'
Private Function m_GetCSVItemValue(ByVal ItemIndex As Integer) As String

    Const CHARCODE_DOUBLEQUOTE = &H22

    Dim i                           As Integer
    Dim strOneStr                   As String
    Dim intItemCount                As Integer
    Dim blnFirstStrFlg              As Boolean      ' 項目の最初の文字か判別
    Dim blnDblQuoteOnFlg            As Boolean      ' 項目が「"」くくられているか判別
    Dim blnBeforStrDblQuoteFlg      As Boolean      ' 前の文字が「"」か判別
    Dim strMakeStr                  As String
    
    ' 1行分の文字列が空なら終了
    If Len(m_strOneLineString) = 0 Then
        m_GetCSVItemValue = ""
        Exit Function
    End If

    ' 初期化
    blnFirstStrFlg = True
    blnDblQuoteOnFlg = False
    blnBeforStrDblQuoteFlg = False
    strMakeStr = ""
    intItemCount = 1
        
    For i = 0 To Len(m_strOneLineString) - 1
        strOneStr = Mid(m_strOneLineString, i + 1, 1)
        Select Case strOneStr
            Case Chr(CHARCODE_DOUBLEQUOTE)
            ' 「"」の場合
                If blnFirstStrFlg = True Then
                ' 項目の最初の文字の場合
                    blnDblQuoteOnFlg = True
                Else
                ' 2文字目以降の文字の場合
                    If blnDblQuoteOnFlg = True Then
                    ' 項目が「"」でくくられている場合
                        If blnBeforStrDblQuoteFlg = True Then
                        ' 前の文字が「"」の場合、エスケープされた「"」とみなす
                            strMakeStr = strMakeStr & strOneStr
                            blnBeforStrDblQuoteFlg = False
                        Else
                        ' 前の文字が「"」でない場合
                            blnBeforStrDblQuoteFlg = True
                        End If
                    Else
                    ' 項目が「"」でくくられてない場合
                        strMakeStr = strMakeStr & strOneStr
                    End If
                End If
                blnFirstStrFlg = False
                
            Case ","
            '「,」の場合
                If blnDblQuoteOnFlg = False Or (blnDblQuoteOnFlg = True And blnBeforStrDblQuoteFlg = True) Then
                ' 「"」でくくられてない、または「"」でくくられていて前の文字が「"」である場合、セパレート文字とみなす。項目確定
                    If intItemCount = ItemIndex Then
                    ' 指定項目の確定
                        Exit For
                    End If
                    
                    ' 指定項目でないので初期化して次の項目へ
                    blnFirstStrFlg = True
                    blnDblQuoteOnFlg = False
                    blnBeforStrDblQuoteFlg = False
                    strMakeStr = ""
                    intItemCount = intItemCount + 1
                Else
                ' セパレート文字でなく文字の「,」とみなす
                    strMakeStr = strMakeStr & strOneStr
                    blnFirstStrFlg = False
                End If
                
            Case Else
            ' 上記以外の場合
                strMakeStr = strMakeStr & strOneStr
                blnFirstStrFlg = False
                                              
        End Select
    Next i

    ' 取得した指定インデックスのCSV項目
    If intItemCount = ItemIndex Then
        m_GetCSVItemValue = strMakeStr
    Else
        m_GetCSVItemValue = ""
    End If

End Function

' Class_Terminate
'
' #デストラクタ
'
Private Sub Class_Terminate()

    On Error Resume Next
    
    ' すべてのオブジェクト破棄
    m_objReadFile.Close
    Set m_objReadFile = Nothing
    Set m_objFS = Nothing
    Set m_colIndex = Nothing
    
    On Error GoTo 0

End Sub

clsReadFixedLenValue.cls

これは固定長ファイル読み込みクラス。以下ソース。

Private m_objFS                 As Object               ' ファイルシステムオブジェクト
Private m_objReadFile           As Object               ' 固定長ファイルオブジェクト
Private m_strFilePath           As String               ' 固定長ファイルパス
Private m_strLine               As String
Private m_blnEndOfStream        As Boolean
Private m_colStart              As New Collection
Private m_colLength             As New Collection
Private m_lngLineCount          As Long
Private m_strRetCode            As String               ' 改行文字

' Class_Initialize
'
' #コンストラクタ
'
Private Sub Class_Initialize()

    ' 初期化
    Set m_objFS = CreateObject("Scripting.FileSystemObject")
    m_lngLineCount = 1
    m_strRetCode = vbCrLf          ' デフォルトの改行コード

End Sub

' SetFilePath
'
' #ファイルパスの設定
'   @param  Path    ファイルパス
'   @return エラーコード
'
Public Function SetFilePath(ByVal Path As String) As Long

    m_strFilePath = Path    ' 固定長ファイルパス設定

    ' ファイル存在チェック
    If Not m_objFS.FileExists(m_strFilePath) Then
    ' ファイル存在エラー
        SetFilePath = ERROR_FILENOTFOUND
        Exit Function
    End If

    On Error Resume Next
    Set m_objReadFile = m_objFS.OpenTextFile(m_strFilePath, FILEOPEN_FORREADING, False)   ' 固定長ファイルオブジェクト作成
    If Err.Number <> 0 Then
    ' ファイルオープンエラー
        SetFilePath = ERROR_FILEOPEN
        Exit Function
    End If
    On Error GoTo 0
    
    If m_objReadFile.AtEndOfStream Then
        m_blnEndOfStream = True
    Else
        m_strLine = m_GetLineString()
        m_blnEndOfStream = False
    End If
    
    SetFilePath = NORMAL_FILEOPEN
    
End Function

' ReturnCode
'
' #改行コードの設定
'   @param  RetCode     改行コード(列挙型)
'
Public Property Let ReturnCode(ByVal RetCode As ReturnCode)

    Select Case RetCode
        Case retCR
        ' キャリッジリターン
            m_strRetCode = vbCr
            
        Case retLF
        ' ラインフィールド
            m_strRetCode = vbLf
            
        Case retCRLF
        ' キャリッジリターン + ラインフィールド
            m_strRetCode = vbCrLf
            
        Case Else
        
    End Select

End Property

' SetValue
'
' #フィールドのセット
'   @param  FieldName   フィールド名
'   @param  Start       スタート点
'   @param  Length      文字列長さ(バイト数)
'
Public Sub SetValue(ByVal FieldName As String, _
                        ByVal Start As Integer, ByVal Length As Integer)

    On Error Resume Next
    m_colStart.Add Item:=CStr(Start), Key:=FieldName
    m_colLength.Add Item:=CStr(Length), Key:=FieldName
    If Err.Number <> 0 Then
        MsgBox "フィールド名がセットできません。重複してないか確認してください。", vbExclamation
    End If
    On Error GoTo 0

End Sub

' HasNext
'
' #次のラインが存在するか判別
'   @return     True    存在する
'               False   存在しない
'
Public Property Get HasNext() As Boolean
      
    HasNext = Not m_blnEndOfStream

End Property

' GetValue
'
' #フィールド値を取得する
'   @param  Field   フィールド名、もじくは文字のスタート位置
'   @return インデックス、もしくはフィールド名に対応する文字列
'
Public Property Get GetValue(ByVal Field As Variant, Optional ByVal Length As Integer = 0) As String

    If VarType(Field) = vbInteger Then
        ' 引数がインデックス指定の場合
        GetValue = StrConv(MidB(StrConv(m_strLine, vbFromUnicode), Field, Length), vbUnicode)
    Else
        ' 引数が指定したフィールド名の場合
        GetValue = StrConv(MidB(StrConv(m_strLine, vbFromUnicode), _
                            CInt(m_colStart.Item(Field)), CInt(m_colLength.Item(Field))), vbUnicode)
    End If

End Property

' NextLine
'
' #次の行に移動
'
Public Sub NextLine()
        
    If m_objReadFile.AtEndOfStream Then
        m_blnEndOfStream = True
    Else
        m_strLine = m_GetLineString()
        m_blnEndOfStream = False
    End If

    m_lngLineCount = m_lngLineCount + 1

End Sub

' GetOneLineString
'
' #1行分の文字列を返す
'   @return     1行分の文字列
'
Public Property Get GetOneLineString() As String

    GetOneLineString = m_strLine

End Property

' Line
'
' #現在行を取得
'   @return     現在行
'
Public Property Get Line() As Long
        
    Line = m_lngLineCount

End Property

' ReSetFile
'
' #ファイルをセットし直す
'   @param  なし
'   @return エラーコード
'
Public Function ReSetFile() As Long

    ' ファイルいったんクローズ
    m_objReadFile.Close
    Set m_objReadFile = Nothing

    ' ファイル存在チェック
    If Not m_objFS.FileExists(m_strFilePath) Then
    ' ファイル存在エラー
        ReSetFile = ERROR_FILENOTFOUND
        Exit Function
    End If

    On Error Resume Next
    Set m_objReadFile = m_objFS.OpenTextFile(m_strFilePath, FILEOPEN_FORREADING, False)   ' 固定長ファイルオブジェクト作成
    If Err.Number <> 0 Then
    ' ファイルオープンエラー
        ReSetFile = ERROR_FILEOPEN
        Exit Function
    End If
    
    If m_objReadFile.AtEndOfStream Then
        m_blnEndOfStream = True
    Else
        m_strLine = m_GetLineString()
        m_blnEndOfStream = False
    End If

    m_lngLineCount = 1

    ' 戻り値、正常コード
    ReSetFile = NORMAL_FILEOPEN

End Function

' m_GetLineString
'
' #1行分の文字列を返す
'   @param  なし
'   @return 1行分の文字列
'
Private Function m_GetLineString() As String
    
    Dim strLine     As String   ' 1行分文字列
    Dim strTmp1     As String   ' 改行コード判別用
    Dim strTmp2     As String   ' 改行コード判別用

    strLine = ""

    Do While Not m_objReadFile.AtEndOfStream
        strTmp1 = m_objReadFile.Read(1)    ' 1文字取得
        strTmp2 = ""
        
        ' 改行判定
        Select Case m_strRetCode
            Case vbCr
            ' キャリッジリターン
                If strTmp1 = vbCr Then
                    Exit Do
                End If
            
            Case vbLf
            ' ラインフィールド
                If strTmp1 = vbLf Then
                    Exit Do
                End If
            
            Case vbCrLf
            ' キャリッジリターン + キャリッジリターン
                If strTmp1 = vbCr Then
                    If Not m_objReadFile.AtEndOfStream Then
                        strTmp2 = m_objReadFile.Read(1)
                        If strTmp2 = vbLf Then
                        ' CRLFである
                            Exit Do
                        End If
                    End If
                End If
            Case Else
        End Select
        
        strLine = strLine & strTmp1 & strTmp2
    Loop

    m_GetLineString = strLine

End Function

' Class_Terminate
'
' #デストラクタ
'
Private Sub Class_Terminate()

    On Error Resume Next
    
    ' すべてのオブジェクト破棄
    m_objReadFile.Close
    Set m_objReadFile = Nothing
    Set m_objFS = Nothing
    Set m_colStart = Nothing
    Set m_colLength = Nothing
    
    On Error GoTo 0

End Sub

使い方

上記ファイルをエクセルにインポートし以下のサンプルコードで使用できる。

' CSVファイルの作成
Public Sub MakeCSVFile()

    Dim objFileIO       As New clsMakeCSV
    Dim i               As Integer

    With objFileIO
        If .SetFilePath(ThisWorkbook.Path & "\" & "MakeCSVFile.csv") = ERROR_FILEOPEN Then
            MsgBox "エラー", vbExclamation
            Set objFileIO = Nothing
            Exit Sub
        End If
        
        ' 装飾設定
'        .Decoration = csvWithSglQuote   ' シングルクォートでくくりたい場合
        .Decoration = csvWithDblQuote   ' ダブルクォートでくくりたい場合
        
        For i = 0 To 10
            .AddValue "a"
            .AddValue "b"
            .AddValue "c", csvWithSglQuote  ' 途中にシングルクォートでくくりたい場合(ないと思うけど)
            .NextLine                       ' 改行
        Next i
    End With
    
    Set objFileIO = Nothing
    
End Sub

' CSVファイルの読み込み
Public Sub ReadCSVFile()

    Dim objFileIO       As New clsReadCSV
    
    With objFileIO
        
        If .SetFilePath(ThisWorkbook.Path & "\" & "ReadCSVFile.csv") = ERROR_FILEOPEN Then
            MsgBox "エラー", vbExclamation
            Set objFileIO = Nothing
            Exit Sub
        End If
        
        ' CSV項目のエイリアス設定
        .SetValue "項目1", 1
        .SetValue "項目2", 2
        .SetValue "項目3", 3
        
        Do While .HasNext
            Debug.Print .GetItemCount       ' カレント行のCSV項目数
            Debug.Print .GetValue("項目1")
            Debug.Print .GetValue("項目2")
            Debug.Print .GetValue("項目3")
            Debug.Print .GetValue(4)        ' エイリアスでなくて列番号で取得する場合(1から)
            .NextLine   ' 次の行へ
        Loop
                
    End With
    
    Set objFileIO = Nothing
    
End Sub

' 固定長ファイルの作成
Public Sub MakeFixedLenFile()

    Dim objFileIO       As New clsMakeFixedLenValue
    Dim i               As Integer
    
    With objFileIO
        If .SetFilePath(ThisWorkbook.Path & "\" & "MakeFixedLenFile.txt") = ERROR_FILEOPEN Then
            MsgBox "エラー", vbExclamation
            Set objFileIO = Nothing
            Exit Sub
        End If

        ' デフォルト装飾設定
        .Decoration = fixlenAlignLeft + fixlenWithNarrowSpace   ' 左寄せ、半角スペース埋め
        
        For i = 0 To 10
            .AddValue "aaa", 10                                     ' 第二引数はバイト数
            .AddValue "bbb", 10, fixlenAlignRight + fixlenWithZero  ' デフォルトと違う場合、個別に指定
            .AddValue "ccc", 10, fixlenAlignLeft + fixlenWithZero   ' デフォルトと違う場合、個別に指定
            .NextLine
        Next i
        
        .NextLine
        
        .NextLine

    End With
    
    Set objFileIO = Nothing
    
End Sub

' 固定長ファイルの読み込み
Public Sub ReadFixedLenFile()

    Dim objFileIO       As New clsReadFixedLenValue
    
    With objFileIO
        If objFileIO.SetFilePath(ThisWorkbook.Path & "\" & "ReadFixedLenFile.txt") <> NORMAL_FILEOPEN Then
            MsgBox "ファイルを開けませんでした。", vbExclamation
            Set objFileIO = Nothing
            Exit Sub
        End If

        ' 固定長ファイルのエイリアス設定
        objFileIO.SetValue "項目1", 1, 3  ' 1バイト目から3バイト分
        objFileIO.SetValue "項目2", 4, 3
        objFileIO.SetValue "項目3", 7, 3
            
        Do While objFileIO.HasNext
            Debug.Print objFileIO.GetValue("項目1")
            Debug.Print objFileIO.GetValue("項目2")
            Debug.Print objFileIO.GetValue(7, 3)    ' エイリアスではなく直接指定したい場合(7バイト目から3バイト分)
            .NextLine   ' 次の行へ
        Loop
    End With
    
    Set objFileIO = Nothing
    
End Sub

作成したモジュール

ExcelFileIO.zip

とうとうMacを買った。

iアプリを作成したくてとうとうMACを買った。ようやく買う気になったのはAppleがswiftなる言語を発表したから、object-cはどうもやる気が起きならかったけど、新しい言語でるならやってみようと思って、

XCodeをダウンロードしてダウンロードしてみた。プロジェクトを作成時にswiftかobject-cか選べる。年内には1つアプリを出そうと思う。

スクリーンショット 2014-07-22 22.11.16

GoogleのAPK翻訳サービス

作るアプリで使用する文字列は基本res/valueフォルダにstrings.xmlとして保存しているが、せっかく定義しているんだから多言語対応したいと思ってるんだけど、こんなサービスがあった。「Google Play App Translation Service」金払えば翻訳してくれるらしい。申し込み方法はandroid developer consoleから左側の「APK」を選択、下に「APK翻訳サービス」というのがる。

translate

今度試してみようと思う。

階層構造をリストフラグメントで作ってみた

アプリで階層構造のリストを作成する機会があって、せっかくなのでサンプルとして残しておこうと思う。おそらく今後使用することはないかもだけど。やりたいこととしては、階層をDBとリストフラグメントを使って表示したい。作成したサンプルアプリは単純にタイトルをリストで表示するだけのもの。作成したものは以下の通り

何がやりたいかというと、下の図みたいなのをリストで表示したい。
hierarchy

DB

DBは「HierarchyList.db」というDBをあらかじめ作成しておき、「assets」フォルダにおいて、そこからコピーして使用する。テーブルレイアウトは以下のレイアウト。「Id」はユニークないID、親の階層を指定するための「ParentId」、一番上の階層の場合は「0」を指定。

CREATE TABLE HierarchyList (
	Id 		INTEGER PRIMARY KEY AUTOINCREMENT,
	ParentId	INTEGER,
	Title		TEXT
);

テーブルのデータは以下。取りあえず3階層まで作ってみた。

Id ParentId Title
1 0 1
2 0 2
3 0 3
4 0 4
5 0 5
6 1 1-1
7 1 1-2
8 1 1-3
9 1 1-4
10 1 1-5
11 2 2-1
12 2 2-2
13 2 2-3
14 2 2-4
15 2 2-5
16 3 3-1
17 3 3-3
18 3 3-3
19 3 3-4
20 3 3-5
21 4 4-1
22 4 4-4
23 4 4-4
24 4 4-4
25 4 4-5
26 5 5-1
27 5 5-5
28 5 5-5
29 5 5-5
30 5 5-5
31 6 1-1-1
32 6 1-1-2
33 6 1-1-3
34 6 1-1-4
35 6 1-1-5
36 7 1-2-1
37 7 1-2-2
38 7 1-2-3
39 7 1-2-4
40 7 1-2-5
41 8 1-3-1
42 8 1-3-2
43 8 1-3-3
44 8 1-3-4
45 8 1-3-5
46 9 1-4-1
47 9 1-4-2
48 9 1-4-3
49 9 1-4-4
50 9 1-4-5
51 10 1-5-1
52 10 1-5-2
53 10 1-5-3
54 10 1-5-4
55 10 1-5-5

プログラム

  • HierarchyListFragment.java
  • ListItem.java
  • DatabaseHelper.java
  • MainActivity.java

MainActivity.java

import android.app.Activity;
import android.app.FragmentTransaction;
import android.database.Cursor;
import android.database.sqlite.SQLiteDatabase;
import android.os.Bundle;
import android.widget.Toast;

public class MainActivity extends Activity {

	@Override
	protected void onCreate(Bundle savedInstanceState) {
		super.onCreate(savedInstanceState);
		setContentView(R.layout.activity_main);

		// リストフラグメントへのパラメータ(ルート)
		Bundle bundle = new Bundle();
		bundle.putInt("parent_id", 0);
		
		// リストフラグメントのセット
        FragmentTransaction ft = getFragmentManager().beginTransaction();
        HierarchyListFragment listFragment = new HierarchyListFragment();
		listFragment.setArguments(bundle);
        ft.replace(R.id.fragment_container, listFragment);
        ft.commit();
	}
	
	/**
     * リストフラグメントアイテムクリックイベント
     */	
	public void onListItemClick(int itemId) {
		// 下階層のチェック
		DatabaseHelper dbHelper = new DatabaseHelper(this);
		SQLiteDatabase db = dbHelper.getReadableDatabase();
	    String query = "SELECT * FROM HierarchyList WHERE ParentId = " + itemId + ";";
	    Cursor c = db.rawQuery(query, null);            
	    if (! c.moveToFirst()) {
	    	Toast.makeText(this, "これより下の階層はありません", Toast.LENGTH_SHORT).show();
	    	c.close();
	    	return;
	    }
	    c.close();
		
		// リストフラグメントへのパラメータ
		Bundle bundle = new Bundle();
		bundle.putInt("parent_id", itemId);
					
		// 次の階層のリストフラグメントの生成
		FragmentTransaction ft = getFragmentManager().beginTransaction();
		HierarchyListFragment listFragment = new HierarchyListFragment();
		listFragment.setArguments(bundle);
        ft.replace(R.id.fragment_container, listFragment);
        ft.addToBackStack(null);
        ft.commit();
	}
}

HierarchyListFragment.java

import java.util.ArrayList;
import java.util.List;
import android.app.ListFragment;
import android.content.Context;
import android.database.Cursor;
import android.database.sqlite.SQLiteDatabase;
import android.os.Bundle;
import android.view.LayoutInflater;
import android.view.View;
import android.view.ViewGroup;
import android.widget.ArrayAdapter;
import android.widget.ListView;
import android.widget.TextView;

public class HierarchyListFragment extends ListFragment {
	private ArrayAdapter<ListItem> adapter;
	private int parentId = 0;
	
	@Override
	public void onActivityCreated(Bundle savedInstanceState) {
		super.onActivityCreated(savedInstanceState);
		
		// パラメータのセット
		parentId = getArguments().getInt("parent_id");
		
		// リストのセット
		setListView();
	}

	@Override
	public View onCreateView(LayoutInflater inflater, ViewGroup container, Bundle savedInstanceState) {
		return inflater.inflate(R.layout.list_fragment, container, false);
	}
	
	@Override
	public void onListItemClick(ListView listView, View v, int position, long id) {
    	super.onListItemClick(listView, v, position, id);
    	
    	// Activityに処理を渡す
    	MainActivity activity = (MainActivity)getActivity();
    	activity.onListItemClick(adapter.getItem(position).getId());
	}
	
	/**
	 * リストのセット
	 */
	public void setListView() {
		// リストのセット
		List<ListItem> list = new ArrayList<ListItem>();
		DatabaseHelper dbHelper = new DatabaseHelper(getActivity());
		SQLiteDatabase db = dbHelper.getReadableDatabase();
	    String query = "SELECT * FROM HierarchyList"
	    					+ " WHERE ParentId = " + parentId + " ORDER BY Id;";
	    Cursor c = db.rawQuery(query, null);            
	    if (c.moveToFirst()) {
	    	do {
	    		ListItem listItem = new ListItem();
	    		listItem.setId(c.getInt(c.getColumnIndex("Id")));
	    		listItem.setTitle(c.getString(c.getColumnIndex("Title")));
	    		listItem.setParentId(c.getInt(c.getColumnIndex("ParentId")));
	    		list.add(listItem);
	    	} while (c.moveToNext());
		}
	    c.close();
		
	    // アダプターのセット
	    adapter = new ListAdapter(getActivity(), list);
	    setListAdapter(adapter);
	}
	
	/**
	 * ListAdapter Class
	 */
	private class ListAdapter extends ArrayAdapter<ListItem> {
		private LayoutInflater mInflater;
		
		public ListAdapter(Context context, List<ListItem> objects) {
			super(context, 0, objects);
			mInflater = (LayoutInflater)context.getSystemService(Context.LAYOUT_INFLATER_SERVICE);
		}
	
		public View getView(int position, View convertView, ViewGroup parent) {
			final ViewHolder holder;
			
			if (convertView == null) {
				convertView = mInflater.inflate(R.layout.listfragment_item, parent, false);
				holder = new ViewHolder();
				holder.tvTittle = (TextView)convertView.findViewById(R.id.title);
				convertView.setTag(holder);
			} else {			
				holder = (ViewHolder)convertView.getTag();
			}
			final ListItem item = this.getItem(position);
			
			holder.tvTittle.setText(item.getTitle());
			
			return convertView;
		}
	} 
	
	/**
	 * ViewHolder for ListView
	 */	
	private class ViewHolder {
		TextView tvTittle;
	}
}

後は省略

レイアウトファイル

作成したレイアウトファイルは以下の通り

  • activity_main.xml
  • fragment_main.xml
  • list_fragment.xml
  • listfragment_item.xml

プログラムの実行

以下のようになる。リストをクリックすると下の階層に行く。
device-2014-06-21-230946device-2014-06-21-230958device-2014-06-21-231007

作成したサンプルプログラム
HierarchyListFragmentSample

sqliteでファイルの違うDBで結合をしたい

androidのSQLiteでDBファイルが違うファイルを結合したい。例えば郵便番号とか都道府県データの静的なDBと動的なユーザー用のDBがあって、静的なDBはassetsからコピー、動的なユーザー用DBは普通に追加訂正削除していく。で、これらを結合したい。調べたら「ATTACH DATABASE」というのを使えばできるみたい。

「DatabaseHelper1」は動的なDB、「DatabaseHelper2」は静的なDBとする。
「DatabaseHelper1」のテーブル「Table1」の列「Id」で「DatabaseHelper2」のテーブル「Table2」で列「Title」を検索すると、以下になる。

DatabaseHelper1 dbHelper = new DatabaseHelper1(this);
SQLiteDatabase db = dbHelper.getReadableDatabase();
db.execSQL("ATTACH DATABASE '" + this.getDatabasePath(DatabaseHelper2.DATABASE_NAME) + "' AS DB2");
String query = "SELECT A.Id, B.Title FROM Table1 A INNER JOIN DB2.Table2 B WHERE A.Id = B.Id;";
Cursor c = db.rawQuery(query, null);

最初にこれをやろうとしたところエラーが出た。内容はText Encordingを合わせる必要があると、エンコーディングは以下のコマンドでわかる。

pragma encoding;

で、sqlite3用ツールで作成した静的DBは「UTF-16le」で、android内で作成した動的DBは「UTF-8」だった。既存の「UTF-16le」のDBを「UTF-8」に変換する方法はわからなかったので(たぶんできない?)、「UTF-8」でDBを作成し直して、データをインポートしたら動いた。