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


