Public Function FindNotePadText(ByVal sTxtFile As String, ByVal sData As String) As Boolean
FindNotePadText = False
On Error Resume Next
Dim TxtFileNumber As Integer
Dim LineContent As String
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Function
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
If InStr(1, LineContent, sData, vbTextCompare) > 0 Then
FindNotePadText = True
Exit Do
End If
Loop
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function
Public Function GetNotePadRowNo(ByVal sTxtFile As String, ByVal sData As String, Optional ByVal bFirst As Boolean = False) As Integer
‘sData 出现在 sTxtFile 的行号，无 sData 为 0，bFirst = True 取第一次，bFirst = False 取最后一次
On Error Resume Next
GetNotePadRowNo = 0
If Not FileExist(sTxtFile) Then Exit Function
Dim TxtFileNumber As Integer
Dim LineContent As String
Dim LineArray() As Integer
Dim LineCount As Integer
Dim LineNumber As Integer
LineCount = 0
LineNumber = 0
TxtFileNumber = FreeFile
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘读文本
Line Input #TxtFileNumber, LineContent
LineNumber = LineNumber + 1
If InStr(1, LineContent, sData, vbTextCompare) > 0 Then ‘出现
LineCount = LineCount + 1
ReDim Preserve LineArray(1 To LineCount)
LineArray(LineCount) = LineNumber
End If
Loop
Close TxtFileNumber
If IsEmptyArray(LineArray) Then Exit Function ‘0
If bFirst Then
GetNotePadRowNo = LineArray(LBound(LineArray))
Else
GetNotePadRowNo = LineArray(UBound(LineArray))
End If
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function
Public Sub ReplaceNotePadText(ByVal sTxtFile As String, ByVal sOld As String, ByVal sNew 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
LineContent = Replace(LineContent, sOld, sNew, 1, -1, vbTextCompare)
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
If iLineCount = 0 Then Exit Sub ‘LBound 会出错
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 TurnNotePadCursor(ByVal sTxtFile As String, ByVal iRow As Integer, Optional ByVal iColumn As Integer = 1, Optional bOpen As Boolean = False) ‘把文本文件光标移到某行某列
On Error Resume Next
Dim I As Integer, J As Integer
Dim oShell As Object
Set oShell = CreateObject(“WScript.Shell”)
If bOpen Then
‘新打开文件
Dim lPid As Long
lPid = Shell(“notepad.exe ” & sTxtFile, vbNormalFocus)
AppActivate (lPid)
Else
‘须紧跟 OpenFile 之后，以保证 sTxtFile 为当前窗体
‘Debug.Print sTxtFile
‘Debug.Print GetShortName(sTxtFile)
For I = 1 To GetNotePadRowCount(sTxtFile, False)
DoEvents
oShell.SendKeys “{UP}” ‘回到首行
Next I
For J = 1 To GetNotePadColumnCount(sTxtFile, False)
DoEvents
oShell.SendKeys “{LEFT}” ‘回到首列
Next J
End If
For I = 1 To iRow – 1
oShell.SendKeys “{DOWN}”
Next I
For J = 1 To iColumn – 1
oShell.SendKeys “{RIGHT}”
Next J
ERR_NORUNNING:
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub
Public Function GetNotePadRowCount(ByVal sTxtFile As String, Optional ByVal bTrimRow As Variant = True) As Integer ‘获取 txt 文件行数, bTrimRow 为真, 则空行 “” 及空格行 ” ” 不计
On Error Resume Next
GetNotePadRowCount = 0
Dim TxtFileNumber As String
TxtFileNumber = FreeFile
If bTrimRow Then
Dim LineContent As String
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
LineContent = Trim(LineContent)
If Not LineContent = “” Then GetNotePadRowCount = GetNotePadRowCount + 1
Loop
Close TxtFileNumber
Else
Open sTxtFile For Binary As #TxtFileNumber
GetNotePadRowCount = UBound(Split(Input(LOF(1), #1), vbCrLf)) + 1
Close #TxtFileNumber
End If
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function
Public Function GetNotePadColumnCount(ByVal sTxtFile As String, Optional ByVal bTrimRow As Variant = True) As Integer ‘获取 txt 文件列数(最大列数)), bTrimRow 为真, 则每行两端的 ” ” 不计
On Error Resume Next
Dim I As Integer, J As Integer
GetNotePadColumnCount = 0
Dim LineContent As String
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Function
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber)
Line Input #TxtFileNumber, LineContent
If bTrimRow Then LineContent = Trim(LineContent)
If Len(LineContent) > GetNotePadColumnCount Then GetNotePadColumnCount = Len(LineContent)
Loop
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function
Public Function GetNotePadColumnCountAtRow(ByVal sTxtFile As String, ByVal iRow As Integer, Optional ByVal bTrimRow As Variant = True) As Integer ‘获取 txt 文件某行列数, bTrimRow 为真, 则行两端的 ” ” 不计
On Error Resume Next
Dim I As Integer, J As Integer
GetNotePadColumnCountAtRow = 0
Dim LineContent As String
Dim TxtFileNumber As Integer
Dim iCount As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Function
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber)
Line Input #TxtFileNumber, LineContent
iCount = iCount + 1
If bTrimRow Then LineContent = Trim(LineContent)
If iCount = iRow Then
GetNotePadColumnCountAtRow = Len(LineContent)
Exit Do
End If
Loop
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function
Public Function GetNotePadRowText(ByVal sTxtFile As String, ByVal iLineNumber As Integer) As String ‘获取 txt 文件某行内容
On Error Resume Next
Dim I As Integer, J As Integer
GetNotePadRowText = “”
If iLineNumber > GetNotePadRowCount(sTxtFile, False) Then Exit Function
Dim oFSO As Object, oFile As Object, oStream As Object
Set oFSO = CreateObject(“Scripting.FileSystemObject”)
Set oFile = oFSO.GetFile(sTxtFile)
Set oStream = oFile.OpenAsTextStream(1, 0)
‘ 读取指定行
For I = 1 To iLineNumber
GetNotePadRowText = oStream.ReadLine
Next
oStream.Close
Set oStream = Nothing
Set oFile = Nothing
Set oFSO = Nothing
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function
