以下是引用风吹过b在2016-10-18 09:00:14的发言：

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

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

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

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

以下是引用ZHRXJR在2016-10-18 12:31:49的发言：

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

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

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

以下是引用风吹过b在2016-10-18 12:34:51的发言：

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

你使用了 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