VB读写Txt文件

每筆記錄以一行表示,每筆記錄的欄位已"@"符號區分.每個欄位的長度皆有其最長的限制.且欄位的定義是以區隔符號位置計算,若該記錄於某欄位後放置分行符號,則其後未填入的欄位以空值填入.

'content 一行记录内容

'contents 全部记录内容数组

'i contents动态数组的长度

Dim content As String
Dim contents() As String
Dim i As Integer

' Function writeTxt  生成文件名为Filename的txt文件,内容为currenttxts
Function writeTxt(Filename As String, currenttxts As Variant)
Dim j As Integer

'Filename其实是文件路径,currenttxts是一个数组
Filename = "C:\" & Filename & ".txt"

'UBound取得currenttxts数组的长度
Debug.Print UBound(currenttxts)

'Open文件For 后面的属性有三个

'append  是在原来内容的基础上添加

'output  重写多行内容

'input 重写记录,并且写记录指针不下移,固定指在第一行

Open Filename For Output As #1
For j = 1 To UBound(currenttxts)
Print #1, currenttxts(j)
Debug.Print currenttxts(j)
Next
Close #1

'打开该TextDocument 文件
Shell "notepad " & Filename
End Function

'读取Field的Value field
Function writeField(field As String)
Dim nField As String
nField = fieldIsEmpty(field)
content = content & nField & "@"
Debug.Print content
End Function
Function writeLine(contenttxt As String)

i = i + 1

'动态定义数组
ReDim Preserve contents(i)
contents(i) = contenttxt
Debug.Print contents(i)

End Function

'判断Field是否为Null或者为""
Function fieldIsEmpty(field As String) As String
Dim mField As String
If field = Null Or field = "" Then
mField = ""
Else
mField = field
End If
fieldIsEmpty = mField
End Function

'生成一个Txt文件
Function createText(sCompany As String, sFileName As String)
Dim rsData As adodb.Recordset, rptCond As clsSQLGenerator, sCommand As String
Set rptCond = New clsSQLGenerator
Call rptCond.sqlRangeCond("MemberID", sMemberID)
Call rptCond.sqlRangeCond("CompanyID", sCompany)
sCommand = "select * from glVoucherDetails " & rptCond.sqlWhereClause(True)

'abPublic是一个数据库连接模块,clsSQLGenerator也是一个sql语句生成模块

Set rsData = dbPublic.ReadSelectCmd(sCommand)
While Not rsData.EOF
Me.writeField (rsData("CompanyID"))
'Me.writeField (rsData("Voucher"))
Me.writeField (rsData("AccountCode"))
Me.writeField (rsData("Currency"))
content = Left(content, Len(content) - 1)
Me.writeLine (content)
content = ""
rsData.MoveNext
Wend
Dim s As String
s = Me.writeTxt(sFileName, contents)
End Function