请楼主将以下代码粘贴于WORD文档的THISDOCUMENT模块下,并据实修改之,然后运行。 '* +++++++++++++++++++++++++++++
'* Created By I Love You_Word!@ExcelHome 2005-7-8 21:59:37
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* -----------------------------Option Explicit
Sub Example()
Dim InputData As String, MyFile As String, MyString As String
Dim TempString As String, N As Byte
Dim Fs As Object, A As Object
Debug.Print Timer
'创建一个对系统文件夹的访问
Set Fs = CreateObject("Scripting.FileSystemObject")
'创建一个文本文件,如果不存在,则创建之,可以修改路径
Set A = Fs.CreateTextFile("D:\Temp\TestFile.txt", True)
'定义源文本文件,请在此修改
MyFile = "D:\Temp\Example.Txt"
Open MyFile For Input As #1 ' 为输入打开文件。
Do While Not EOF(1) ' 检查文件尾。
Line Input #1, InputData ' 读入一行数据
'如果此行数据不为空并且不是全部为空格的话
If Len(InputData) > 1 And VBA.Replace(InputData, " ", "") <> "" Then
'计数
N = N + 1
If N = 1 Then
'根据指定的字符位置进行提取字符串
MyString = VBA.Mid(InputData, 1, 12) & "|"
MyString = MyString & Replace(VBA.Mid(InputData, 13, 50), " ", "") & "|"
Else
MyString = MyString & Replace(VBA.Mid(InputData, 1, 45), " ", "") & "|"
MyString = MyString & Replace(VBA.Mid(InputData, 46, 20), " ", "") & "|"
'每次到第二行后,写入指定的文本文件中,并初始化MyString变量
N = 0: A.WriteLine (MyString): MyString = ""
End If
End If
LP: Loop
A.Close
Close #1 ' 关闭文件。
Debug.Print Timer
End Sub
'---------------------- |