将一文本文件按要求分离成多个文本文件，能否在分离的单个文本文件起始行加入 文本头.txt内容，在每个分离的单个文本尾行加入 文本尾.txt内容
程序执行界面

正常分离界面

加入文本头.txt、文本尾.txt界面

程序代码

VB操作txt文档，可以读取或者写入，读、写不能同时。但是不支持直接修改。
所以你要求的分离文件没有问题。 只是需要你自己在什么位置分割。

Open "C:\原始.txt" For input as #1
Open "C:\1.txt" For output as #2
Open "C:\2.txt" For output as #3
……
Do while not EOF(1)
line input #1, a

 '这里加判断语句，判断输出到哪个文件中，
  

 '下面输出到第一个文件为例
 Print #2, a

Loop

Close #1
Close #2
Close #3

在现有文本中插入，不能直接实现，因为不能对一个文件同时读和写。
这个可以从原始文件中读取，写入一个新的文件，在文件头或者文件尾把需要的内容插入即可。如果一定要同样的名字，只能弄完之后改名了

分割前，先把 文本头.txt 和 文本尾.txt 的内容读到内存中。

然后分割时保存时，先把 文本头 写进去，再写需要保存的内容，最后再写 文本尾 即可。

print #2,文本头
你保存分割文件代码
print #2,文件尾

就是这样的增加到你的代码中去。

谢谢，那如果直接将两个文本内容写进程序里进行分离，就当不存在那两个文本了，该如何操作呢？曾试着那样做过，分离时总是有文件缺少或多出行内容。

能帮忙修改下代码来实现么，曾经也试过因能力问题，分离数据异常混乱，谢谢。

代码逻辑很乱，多次打开文件（慢速操作），看不懂文件的算法，无法加入我前面的算法。


Private Sub cmdStartProcess_Click()
On Error GoTo PROCESS_ERROR
    Dim FileNumber As Integer '可用的文件号
    Dim fin As String       '用于读取的数据文件
    Dim fout As String      '用于输出的文件
    Dim savePath As String  '文件保存路径
    Dim curLine As String   '当前读取的行
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim pin As String
   
    Dim Ft As String    '文件头
    Dim Fw As String    '文件尾
    '文件位于APP的上一层目录，需要时自己改
    Dim ts As Object
    Dim fout2 As String    '前一次的文件名   
   
    fin = App.Path
    If Right(fin, 1) <> "\" Then fin = fin & "\"
    fin = fin & "..\文本头.txt"
    If fso.FileExists(fin) Then
        Set ts = fso.opentextfile(fin, 1, True)     '创建文件读取对象,用于字符文件
        Ft = ts.readall                             '用文件读取对象读出文件内容
        ts.Close
        Set ts = Nothing
    End If
   
    fin = App.Path
    If Right(fin, 1) <> "\" Then fin = fin & "\"
    fin = fin & "..\文本尾.txt"
    If fso.FileExists(fin) Then
        Set ts = fso.opentextfile(fin, 1, True)     '创建文件读取对象,用于字符文件
        Fw = ts.readall                             '用文件读取对象读出文件内容
        ts.Close
        Set ts = Nothing
    End If
   
   
   
    fin = Trim$(txtFile.Text)
    savePath = Trim$(txtPath.Text)
   
    If fso.FileExists(fin) = False Then
        MsgBox "您选择的数据文件无效,请重新选择!", vbExclamation, "信息"
        txtFile.SetFocus
        Exit Sub
    End If
   
    If Val(txtVar.Text) < 1 Then
        MsgBox "请输入有效的变量位数!", vbExclamation, "信息"
        txtVar.SetFocus
        Exit Sub
    End If
   
    If Len(savePath) = 0 And fso.FolderExists(savePath) = False Then
        MsgBox "你选择的文件保存路径无效,请重新选择!", vbExclamation, "信息"
        txtPath.SetFocus
        Exit Sub
    End If
   
    If Right$(savePath, 1) <> "\" Then savePath = savePath + "\"
   
    Open fin For Input Access Read As #1
    Do While Not EOF(1)
        FileNumber = FreeFile       '获取一下可用的文件号
        Line Input #1, curLine      '读取一行
        fout = savePath + Text1.Text & Mid$(curLine, CInt(txtVar.Text), CInt(txtVaren.Text) - CInt(txtVar.Text) + 1) + ".txt" '设置用于输出数据的文件名称
        
        If fout <> fout2 Then       '如果上次的文件名与本次的不相同
            If Len(fout2) > 0 Then  '如果上次的文件名不为空
            Open fout2 For Append Access Write As #FileNumber            '打开输出文件
            Print #FileNumber, Fw   '写入文件尾
            Close #FileNumber
            End If
        End If
        
        Open fout For Append Access Write As #FileNumber            '打开输出文件
        
        If fout <> fout2 Then       '如果上次的文件名与本次的不相同
            Print #FileNumber, Ft   '写入文件头
            fout2 = fout            '保存写入文件头的文件名
        End If
        Print #FileNumber, curLine      '写入当前行
        Close #FileNumber               '关闭文件
        
        
        
    Loop
   
        '最后一个文件写文件尾
        If Len(fout2) > 0 Then  '如果上次的文件名不为空
            Open fout2 For Append Access Write As #FileNumber            '打开输出文件
            Print #FileNumber, Fw   '写入文件尾
            Close #FileNumber
        End If
   
    Close #1
    Set fso = Nothing
   
    MsgBox "文件处理完成。", vbInformation + vbOKOnly, "信息"
    Exit Sub
PROCESS_ERROR:
    MsgBox "发生了一个运行时错误: " + vbCrLf + Err.Description, vbOKOnly + vbExclamation, "错误"
End Sub

再仔细看了一下你的程序，以及提供的源数据。
发现一个BUG，我现在这种方法，只能应对你原始数据是排好了序的，也就是同样序号的内容必须放一起。否则就会导致重复写入文件头和文件尾。

我认为只需要一个打开文件对话框就可以解决问题，不需要API函数。这个是比较简单的程序，打开文件，操作文件就可以完成：

下面是程序生成的三个文本文件：

如果需要原程序，给你的地址。

我一般就啥问题就说啥问题，不去大改程序。

你使用了 FSO 文件对象，那通遍就继续用 FSO 对象吧。

Private Sub cmdStartProcess_Click()
On Error GoTo PROCESS_ERROR
    Dim FileNumber As Integer '可用的文件号
    Dim fin As String       '用于读取的数据文件
    Dim fout As String      '用于输出的文件
    Dim savePath As String  '文件保存路径
    Dim curLine As String   '当前读取的行
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim pin As String
   
    Dim Ft As String    '文件头
    Dim Fw As String    '文件尾
    '文件位于APP的上一层目录，需要时自己改
    Dim ts As Object
    Dim fout2 As String    '前一次的文件名
    
    Dim s As String
    Dim fj() As String
    Dim tit() As String
    Dim i As Long
    Dim j As Long, j2 As Long
    Dim tvar As Long, tvaren As Long
    
    tvar = CInt(txtVar.Text)
    tvaren = CInt(txtVaren.Text)
    
    fin = App.Path
    If Right(fin, 1) <> "\" Then fin = fin & "\"
    fin = fin & "..\文本头.txt"
    If fso.FileExists(fin) Then
        Set ts = fso.opentextfile(fin, 1, True)     '创建文件读取对象,用于字符文件
        Ft = ts.readall                             '用文件读取对象读出文件内容
        ts.Close
    End If
    
    fin = App.Path
    If Right(fin, 1) <> "\" Then fin = fin & "\"
    fin = fin & "..\文本尾.txt"
    If fso.FileExists(fin) Then
        Set ts = fso.opentextfile(fin, 1, True)     '创建文件读取对象,用于字符文件
        Fw = ts.readall                             '用文件读取对象读出文件内容
        ts.Close
    End If
    
    fin = Trim$(txtFile.Text)
    savePath = Trim$(txtPath.Text)
    
    If fso.FileExists(fin) = False Then
        MsgBox "您选择的数据文件无效,请重新选择!", vbExclamation, "信息"
        txtFile.SetFocus
        Exit Sub
    End If
    
    If Val(txtVar.Text) < 1 Then
        MsgBox "请输入有效的变量位数!", vbExclamation, "信息"
        txtVar.SetFocus
        Exit Sub
    End If
    
    If Len(savePath) = 0 And fso.FolderExists(savePath) = False Then
        MsgBox "你选择的文件保存路径无效,请重新选择!", vbExclamation, "信息"
        txtPath.SetFocus
        Exit Sub
    End If
    
    If Right$(savePath, 1) <> "\" Then savePath = savePath + "\"
    
        Set ts = fso.opentextfile(fin, 1, True)     '创建文件读取对象,用于字符文件
        s = ts.readall                             '用文件读取对象读出文件内容
        ts.Close
        Set ts = Nothing
        
        fj = Split(s, vbCrLf)
        
        j2 = 0
        ReDim tit(j2)
        For i = 0 To UBound(fj)
            If Len(fj(i)) > tvaren Then                      '该行数据长度超过输入的参数长度，则处理
                s = Mid(fj(i), tvar, tvaren - tvar + 1)     '取标志
                For j = 1 To j2                             '扫描标志库
                    If tit(j) = s Then Exit For             '如果存在于标志库中，退出遍类
                Next j
                If j > j2 Then                              '如果是中途退出，不存在标志库中
                    j2 = j2 + 1
                    ReDim Preserve tit(j2)                  '
                    tit(j2) = s                             '保存标志
                End If
            End If
        Next i
        
        For j = 1 To j2
        fin = savePath & Text1.Text & Trim(tit(j)) & ".txt"         '文件名去空格处理
        Set ts = fso.opentextfile(fin, 2, True)     '创建文件写入对象,用于字符文件
            ts.write Ft                                             '写文件头
            ts.write vbCrLf                     '不会自动写入回车，手动写
            For i = 0 To UBound(fj)
                If Len(fj(i)) > tvaren Then                      '该行数据长度超过输入的参数长度，则处理
                    s = Mid(fj(i), tvar, tvaren - tvar + 1)
                    If s = tit(j) Then                      '是否属于该标志
                        ts.write fj(i)                      '是，写入
                        ts.write vbCrLf                     '不会自动写入回车，手动写
                    End If
                End If
            Next i
            ts.write Fw                                     '写文件尾
            ts.write vbCrLf                     '不会自动写入回车，手动写
            ts.Close
        Next j
        
        Set ts = Nothing
                
    Set fso = Nothing
    
    MsgBox "文件处理完成。", vbInformation + vbOKOnly, "信息"
    Exit Sub
PROCESS_ERROR:
    MsgBox "发生了一个运行时错误: " + vbCrLf + Err.Description, vbOKOnly + vbExclamation, "错误"
End Sub

谢谢关注，分离文件的数量是根据源文件的起始列号包含数据是否相同来作为分离条件的，您这里思路很好，只是不见分离条件就失去意义了。
虽然结贴，然仍希望您能继续赐教，谢谢，若能百忙加入分离条件（分离文件个数是以条件自动产生）的源代码，希望能发送一下，也多一下
学习的思路。

[此贴子已经被作者于2016-10-18 14:31编辑过]