公司现在需要一个可以自由截取文本文件内容的软件!我想用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行!
不知道我写的清楚不清楚!
求解关于自由截取文本文件内容的程序!

解决方案 »

  1.   

    如果你每一行的长度都是固定的话那就可以用seek啊
      

  2.   

    Private Sub Command1_Click()
    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