信息技术

Sub 转换为RTF()

'这个程序是利用Word2000把批量DOC文件转换为批量RTF文件。

'使用这个宏前，请先用DOS命令进入你要转换的文件目录，然后用“DIR *.doc >cc.txt /b”命

'令生成一个叫做cc的文件。然后再运行宏。如果在Win9x下，完全可以用Shell命令代替。

'使用方法：

'启动Word，单击菜单`“工具－宏－宏”，输入宏的名称比如“转换为RTF”，单击“创建”按钮

'将这些所有内容粘贴到宏编辑器中，保存，切换到Word，单击菜单`“工具－宏－宏”，选中“转换为RTF”，单击“运行”按钮

qwe = Chr(-19214) + Chr(-19015) + Chr(-12568) + Chr(-10064) + Chr(-10284) + Chr(-12084) + Chr(-23647)

qwe = qwe + Chr(-19214) + Chr(-19015) + Chr(-17754) + Chr(-14133) + Chr(-17754) +

Chr(-17222) + Chr(87) + Chr(111) + Chr(114) + Chr(100) + Chr(-23647)

qwf = Chr(-15133) + Chr(-12884) + Chr(-11550) + Chr(-15632) + Chr(-23617)

qwe = qwe + Chr(10) + Chr(10) + "使用这个宏前，请先用DOS命令进入你要转换的文件目录，然后用“DIR *.doc >cc.txt /b”命"

qwe = qwe + "令生成一个叫做cc的文件。然后再运行宏。如果你没有提前生成CC.TXT文件，请按N退出。"

qwe = " " + qwe

asd = MsgBox(qwe, 4, qwf)

If asd <> 6 Then End

xx = InputBox("请输入转换路径(可以把地址栏里的路径粘贴过来)")

bb = xx + "\cc.txt"

Dim DOC文件名$(100000)

Open bb For Input As #1

While Not EOF(1)

Line Input #1, DOC文件名$(i)

RTF文件名 = Left(DOC文件名$(i), Len(DOC文件名$(i)) - 3) + "RTF"

TXT文件名 = Left(DOC文件名$(i), Len(DOC文件名$(i)) - 3) + "TXT"

Documents.Open FileName:=xx + "\" + DOC文件名$(i) ' 打开一个DOC文件

ActiveDocument.SaveAs FileName:=xx + "\" + RTF文件名, FileFormat:=wdFormatRTF
'另存为RTF文件

'ActiveDocument.SaveAs FileName:=xx + "\" + RTF文件名, FileFormat:=wdFormatText '

另存为TXT文件

'去掉上一行走左边的单引号可生成TXT文件

ActiveDocument.Close '关闭文件

i = i + 1

Wend

Close #1

MsgBox "所有的DOC转换完毕，现在DOC可以删除了，再也不会有宏病毒了。 "

End Sub
出自:http://bbs.yesky.com/bbs/jsp/viewbest.jsp?articleID=241959