公司现在需要一个可以自由截取文本文件内容的软件!我想用VB编!
我们现在用VB读写文本文件用的都是filesystemobject,但是我发现FSO里面不能读取指定行数的内容!也许我没找到吧!我知道一个seek可以当作指针来用!但他怎么和FSO一起用呢?我想了一天了!还没想出来!请大虾们帮帮我!我现在做的只能第一次自由截取,后来就无法接着截取了!不知道怎么确定下一个截取时的开始地址!
原始数据: 输出文本1: 输出文本2:
5789528462158700 5789528462158700 5789528462158710
5789528462158701 5789528462158701 .
5789528462158702 5789528462158702 .
5789528462158703 5789528462158703 .
5789528462158704 5789528462158704 .
5789528462158705 5789528462158705 .
5789528462158706 5789528462158706 .
5789528462158707 5789528462158707 5789528462158724
5789528462158708 5789528462158708
5789528462158709 5789528462158709
5789528462158710 共十行 共十五行
5789528462158711
5789528462158712
5789528462158713
5789528462158714
5789528462158715
5789528462158716
5789528462158717
5789528462158718
5789528462158719
5789528462158720
5789528462158721
5789528462158722
5789528462158723
5789528462158724
共25行!
不知道我写的清楚不清楚!
求解关于自由截取文本文件内容的程序!
我们现在用VB读写文本文件用的都是filesystemobject,但是我发现FSO里面不能读取指定行数的内容!也许我没找到吧!我知道一个seek可以当作指针来用!但他怎么和FSO一起用呢?我想了一天了!还没想出来!请大虾们帮帮我!我现在做的只能第一次自由截取,后来就无法接着截取了!不知道怎么确定下一个截取时的开始地址!
原始数据: 输出文本1: 输出文本2:
5789528462158700 5789528462158700 5789528462158710
5789528462158701 5789528462158701 .
5789528462158702 5789528462158702 .
5789528462158703 5789528462158703 .
5789528462158704 5789528462158704 .
5789528462158705 5789528462158705 .
5789528462158706 5789528462158706 .
5789528462158707 5789528462158707 5789528462158724
5789528462158708 5789528462158708
5789528462158709 5789528462158709
5789528462158710 共十行 共十五行
5789528462158711
5789528462158712
5789528462158713
5789528462158714
5789528462158715
5789528462158716
5789528462158717
5789528462158718
5789528462158719
5789528462158720
5789528462158721
5789528462158722
5789528462158723
5789528462158724
共25行!
不知道我写的清楚不清楚!
求解关于自由截取文本文件内容的程序!
CommonDialog1.fileName = ""
CommonDialog1.InitDir = App.Path
CommonDialog1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.fileName
CommonDialog1.FilterIndex = 0
End SubPrivate Sub Command2_Click()
Dim inputFile As FileSystemObject
Dim inputText As TextStream
Dim outputFile As FileSystemObject
Dim outputText As TextStream
Dim fileName As String
Dim M As String
Dim F As Long
Dim X As LongIf Text1.Text = "" Then
MsgBox "请填写源文件路径!", 48
Exit Sub
End If
If Text2.Text = "" Then
MsgBox "请填写您需要截取的行数!", 48
Exit Sub
End If
If Text3.Text = "" Then
MsgBox "请填写地区名称!", 48
Exit Sub
End If
fileName = Trim(Text1.Text)
If fileName = "" Then
MsgBox "输入信息不完整!", 48
Exit Sub
End If
charPos = findLastChar(fileName, "\")
fileName = Mid(fileName, charPos + 1)
charPos = InStr(fileName, ".")
fileName = Left(fileName, charPos - 1)
Set inputFile = CreateObject("scripting.filesystemobject")
Set inputText = inputFile.OpenTextFile(Trim(Text1.Text), ForReading)
Set outputFile = CreateObject("scripting.filesystemobject")
Set outputText = outputFile.CreateTextFile(App.Path & "\" & fileName & "_" & Text3.Text & ".txt", True)F = 0
Do While inputText.AtEndOfLine <> True
M = inputText.ReadLine
F = F + 1
Loop
Label5.Caption = Str(F)
inputText.CloseLabel3.Caption = Str(Val(Label3.Caption) + Val(Text2.Text))If Val(Label3.Caption) > Val(Label5.Caption) Then
MsgBox "现在的文件地址已经超过文件总长度!", 48
Exit Sub
End If
If Val(Text2.Text) > Val(Label5.Caption) Then
MsgBox "您所填写的截取长度超过了文件的总长度!请核实后再填写!", 48
Exit Sub
End IfSet inputText = inputFile.OpenTextFile(Trim(Text1.Text), ForReading)
For X = 1 To Val(Text2.Text) Step 1
M = inputText.ReadLine
outputText.WriteLine (M)
Next X
outputText.Close
Command4.Visible = True
Command2.Visible = False
MsgBox "处理完毕!如要继续截取请选择继续截取。想重新开始请选择重新开始!", 48
End SubPrivate Sub Command3_Click()
End
End SubPrivate Sub Command4_Click()
Dim inputFile As FileSystemObject
Dim inputText As TextStream
Dim outputFile As FileSystemObject
Dim outputText As TextStream
Dim fileName As StringDim F As Long
Dim a As String
Dim Y As LongIf Text1.Text = "" Then
MsgBox "请填写源文件路径!", 48
Exit Sub
End If
If Text2.Text = "" Then
MsgBox "请填写您需要截取的行数!", 48
Exit Sub
End If
If Text3.Text = "" Then
MsgBox "请填写地区名称!", 48
Exit Sub
End IffileName = Trim(Text1.Text)
If fileName = "" Then
MsgBox "输入信息不完整!", 48
Exit Sub
End If
charPos = findLastChar(fileName, "\")
fileName = Mid(fileName, charPos + 1)
charPos = InStr(fileName, ".")
fileName = Left(fileName, charPos - 1)Label3.Caption = Str(Val(Label3.Caption) + Val(Text2.Text))
If Val(Label3.Caption) > Val(Label5.Caption) Then
MsgBox "现在的文件地址已经超过文件总长度!", 48
Exit Sub
End If
If Val(Text2.Text) > Val(Label5.Caption) Then
MsgBox "您所填写的截取长度超过了文件的总长度!请核实后再填写!", 48
Exit Sub
End IfSet inputFile = CreateObject("scripting.filesystemobject")
Set inputText = inputFile.OpenTextFile(Trim(Text1.Text), ForReading)
Set outputFile = CreateObject("scripting.filesystemobject")
Set outputText = outputFile.CreateTextFile(App.Path & "\" & fileName & "_" & Text3.Text & ".txt", True)F = 0
Do While inputText.AtEndOfLine <> True
inputText.SkipLineF = F + 1If F = Val(Label3.Caption) - Val(Text2.Text) ThenFor Y = 1 To Val(Text2.Text) Step 1
a = inputText.ReadLine
outputText.WriteLine (a)
Next Y
Exit DoEnd If
LoopoutputText.Close
inputText.Close
MsgBox "处理完毕~~~~", 48
End SubPrivate Sub Command5_Click()
Text1.Text = ""
Text2.Text = ""
Label3.Caption = ""
Label5.Caption = ""
Text3.Text = ""
Command4.Visible = False
Command2.Visible = True
End Sub
嘿嘿~~~这是我自己编的~~~也许还不太成熟~~~但已经可以任意截取文本文件的了!
下面还有一个模块~~~是自动保存的!
Option Explicit
Function findLastChar(a As String, b As String) As Integer
Dim charPos As Integer
charPos = InStr(a, b)
Do While charPos <> 0
findLastChar = charPos
charPos = InStr(charPos + 1, a, b)
LoopEnd Function