一个VBA处理CSV文件的类模块

分类:代码, 博客 标签:

CSV格式文件在日常工作也经常会用到,这里提供一个VBA处理CSV文件的类模块,方便对这种格式文件的处理,水文数据也常用这一格式的数据进行交换,这里实现的这一类模块使用的CSV文件默认分隔符是逗号,使用时可以做更改,具体实现代码如下:

Option Explicit
'================================
' 一个VBA处理CSV文件的类模块
'
' http://www.cnhup.com
'================================
Dim FSO
Dim TS
Private mvarFileName        As String
Private mvarFieldCount      As Integer
Private mvarStatus          As Boolean
Private strRecord           As String
Private Fields()            As String
Private strErrMsg           As String
Private mvarFieldSeperator  As String

Public Function GetErrorMessage() As String
    GetErrorMessage = strErrMsg
End Function

Public Property Let FieldSeperator(ByVal vData As String)
    mvarFieldSeperator = Trim(vData)
End Property

Public Property Get FieldSeperator() As String
    FieldSeperator = mvarFieldSeperator
End Property

Private Property Let Status(ByVal vData As Boolean)
    mvarStatus = vData
End Property

Public Property Get Status() As Boolean
    Status = mvarStatus
End Property

Public Property Get FieldCount() As Integer
    FieldCount = mvarFieldCount
End Property

Public Property Let FileName(ByVal vData As String)
    mvarFileName = vData
    mvarStatus = AccessTargetFile()
End Property

Public Function LoadNextLine() As Boolean
    On Error GoTo LoadNextLine_Err
    If TS.AtEndOfStream Then
        LoadNextLine = False
        Exit Function
    End If
    strRecord = TS.ReadLine
    ReDim Fields(0)
    Fields = Split(strRecord, FieldSeperator)
    mvarFieldCount = UBound(Fields) + 1
    LoadNextLine = True
    Exit Function
LoadNextLine_Err:
    LoadNextLine = False
End Function

Public Function GetField(FieldNum As Integer) As String
    If FieldNum < 1 Or FieldNum > FieldCount Then
        GetField = ""
    Else
        GetField = Trim(Fields(FieldNum - 1))
    End If
End Function

Private Function AccessTargetFile() As Boolean
    On Error Resume Next
    TS.Close                    'Close if open.
    On Error GoTo AccessTargetFile_Err
    Status = True
    strErrMsg = ""
    Set TS = FSO.OpenTextFile(mvarFileName, ForReading)
    AccessTargetFile = True
    Status = True
    Exit Function
AccessTargetFile_Err:
    strErrMsg = CStr(Err.Number) & " " & Err.Description & " in AccessTargetFile."
    AccessTargetFile = False
End Function

Private Sub Class_Initialize()
    Status = False
    FieldSeperator = ","
    mvarFileName = ""
    Set FSO = CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Class_Terminate()
    Set FSO = Nothing
    Set TS = Nothing
End Sub


分类:代码, 博客 标签:

发表评论

You must be logged in to post a comment.