|
新加一个模块。将下面代码粘贴进去。
注意Test过程中的文件名。
- Option Explicit
- Public Function 文本处理(ByVal FileName1 As String, ByVal FileName2 As String)
- 'FileName1:要处理的文件名
- 'FileName2:处理后保存的文件名(注:如果文件已经存在,将删除原文件)
- Dim I As Long, FileL As Long
- Dim byteD() As Byte
- Dim strFiles() As String, strFile As String
-
- On Error Resume Next
-
- FileL = FileLen(FileName1)
- If FileL > 0 Then
- ReDim byteD(FileL - 1)
- FileL = FreeFile
- Open FileName1 For Binary As FileL
- Get FileL, , byteD
- Close FileL
- strFile = StrConv(byteD, vbUnicode)
- Erase byteD
- strFiles = Split(Replace(Replace(strFile, """", vbNullString), " ", vbNullString), vbCrLf)
- strFile = vbNullString
- For I = 0 To UBound(strFiles)
- Select Case True
- Case Mid(strFiles(I), 1, 1) = ":": strFile = Mid(strFile, 1, Len(strFile) - 1) & vbCrLf
- Case IsNumeric(Split(strFiles(I), "=")(0)): strFile = strFile & Replace(Split(strFiles(I), "=")(1), " ", vbNullString)
- End Select
- Next I
- byteD = StrConv(strFile, vbFromUnicode)
- FileL = FreeFile
- If Len(Dir(FileName2, vbHidden Or vbNormal Or vbReadOnly Or vbSystem Or vbArchive)) Then
- SetAttr FileName2, vbNormal
- Kill FileName2
- End If
- Open FileName2 For Binary As FileL
- Put FileL, , byteD
- Close FileL
- Erase byteD
- Erase strFiles
- strFile = vbNullString
- End If
- End Function
- Public Sub Test()
- 文本处理 ThisWorkbook.Path & "\待处理.txt", ThisWorkbook.Path & "\处理1.txt"
- End Sub
复制代码 |
|