代码逻辑很乱,多次打开文件(慢速操作),看不懂文件的算法,无法加入我前面的算法。
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