| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2290 人关注过本帖
标题:文本文件分离多个文件,如何在分离的文件里加入指定文本内容?
只看楼主 加入收藏
chuxue007
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2016-4-9
收藏
得分:0 
以下是引用风吹过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

茅塞顿开,您一定有更理想简洁的办法实现问题,然正像您所说,授人以鱼不如授人以渔,因为考虑在提问者的架构上解决问题,
更容易理解及找到解决问题的结症所在,谢谢。
2016-10-18 14:26
快速回复:文本文件分离多个文件,如何在分离的文件里加入指定文本内容?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.019222 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved