以下是引用风吹过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
我一般就啥问题就说啥问题,不去大改程序。
你使用了 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
茅塞顿开,您一定有更理想简洁的办法实现问题,然正像您所说,授人以鱼不如授人以渔,因为考虑在提问者的架构上解决问题,
更容易理解及找到解决问题的结症所在,谢谢。