NotePad 函数系列之二

Public Sub TampNotePad(ByVal sTxtFile As String, Optional ByVal bTrimRow As Variant = True) ‘对文本文件消除空行, bTrimRow 为真, 则行 ” ” 视为空行 “”
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim LineContent As String
Dim iLineCount As Integer
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Sub
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
Open sTxtFile For Output As TxtFileNumber
For I = 1 To iLineCount ‘把数组写入文本
If bTrimRow Then Lines(I) = Trim(Lines(I))
If Not Lines(I) = “” Then Print #TxtFileNumber, Lines(I)
Next I
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub

Public Sub TrimNotePad(ByVal sTxtFile As String, Optional ByVal bTrimRow As Variant = True) ‘对文本文件消除前后空行, 中间空行不管, bTrimRow 为真, 则行 ” ” 视为空行 “”
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim LineContent As String
Dim iLineCount As Integer
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Sub
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
Dim iBegin As Integer, iEnd As Integer
For I = 1 To iLineCount
If bTrimRow Then Lines(I) = Trim(Lines(I))
If Not Lines(I) = “” Then
iBegin = I
Exit For
End If
Next I
For I = iLineCount To 1 Step -1
If bTrimRow Then Lines(I) = Trim(Lines(I))
If Not Lines(I) = “” Then
iEnd = I
Exit For
End If
Next I
Open sTxtFile For Output As TxtFileNumber
For I = iBegin To iEnd ‘把数组写入文本
Print #TxtFileNumber, Lines(I)
Next I
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub

Public Sub CleanNotePad(ByVal sTxtFile As String) ‘对文本文件消除重复行
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim LineContent As String
Dim iLineCount As Integer
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Sub
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
Call CleanUpArray(Lines) ‘去除重复元素
iLineCount = UBound(Lines) – LBound(Lines) + 1
Open sTxtFile For Output As TxtFileNumber
For I = 1 To iLineCount
Print #TxtFileNumber, Lines(I)
Next I
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub

Public Sub SortNotePad(ByVal sTxtFile As String, ByVal bAscending As Boolean) ‘对文本文件按行排序
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim LineContent As String
Dim iLineCount As Integer
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Sub
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
If iLineCount = 0 Then Exit Sub ‘LBound 会出错
Dim iBest As Integer
Dim sBest As String
For I = 1 To iLineCount – 1 ‘对数组进行有序处理
iBest = I
sBest = Lines(I)
For J = I + 1 To iLineCount
If StrComp(Lines(J), sBest, vbTextCompare) < 0 Then sBest = Lines(J) iBest = J End If Next J Lines(iBest) = Lines(I) Lines(I) = sBest Next I Open sTxtFile For Output As TxtFileNumber If bAscending = True Then ‘把数组写入文本 ‘Ascending order For I = 1 To iLineCount Print #TxtFileNumber, Lines(I) Next I Else ‘Descending order For I = iLineCount To 1 Step -1 Print #TxtFileNumber, Lines(I) Next I End If Close TxtFileNumber If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub

Public Sub ClearNotePad(ByVal sTxtFile As String) ‘保留文本文件但清空其内容
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
Open sTxtFile For Output As TxtFileNumber
For I = LBound(Lines) To UBound(Lines) ‘把数组写入文本
Print #TxtFileNumber, Lines(I)
Next I
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub