使用VBA处理冀教版信息技术参考资料
冀教版信息技术参考资料组织格式如图，其中对我们写教案有参考价值的是那些word文件。通过Word当中所带的VBA功能，实现将无规则的文件名保存成有实际意义的文件名。
首先，我们通过下面的vbs脚本遍历目录，将其中的word文件复制到一个临时文件夹c:\temp中。
On Error Resume Next
dir = "E:\CZ_1\images\XK17_NJ07\"
copy_doc (dir)
MsgBox " 完成！"
Sub copy_doc(dir)
On Error Resume Next
Dim fso, f, fldr, folder, len_f, strFileName, strFileExt, temp
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(dir)
For Each folder In fldr.SubFolders
For Each subfolder In folder.SubFolders
For Each f In subfolder.Files
If Right(f.Name, 4) = ".doc" Then
fso.CopyFile f, "c:\temp\"
End If
Next
Next
Next
Set folder = Nothing
Set fso = Nothing
End Sub
然后，在word当中使用以下VBA来实现文件改名，将改名后的文件放入c:\tmp中。
Sub RenDoc()
On Error Resume Next
Dim FSO As New Scripting.FileSystemObject, fFile As Scripting.File
Dim title As String
For Each fFile In FSO.GetFolder("c:\temp").Files
Documents.Open "c:\temp\" & fFile.Name
ActiveDocument.Paragraphs(1).Range.Select
title = Trim(Selection.Text)
slen = Len(title)
title = Left(title, slen - 1)
If title <> "" Then
ChangeFileOpenDirectory "C:\tmp\"
ActiveDocument.SaveAs title
End If
ActiveDocument.Close
Next
Set FSO = Nothing
End Sub
本来，使用vbs也可以实现，但好像是效率不高，这是参考代码，我没有调试
dir = "c:\tmp\"
copy_doc(dir)
msgbox " 完成！"
Sub copy_doc(dir)
Dim fso, f, fldr, folder, len_f, strFileName, strFileExt, temp
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(dir)
For Each f In fldr.Files
Dim objWord, objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("c:\temp\" & f.Name)
objDoc.Paragraphs(1).Range.Select
temp = objWord.Selection.Text
slen = Len(temp)
temp = Left(temp, slen - 1)
objWord.ActiveDocument.SaveAs temp
objWord.Quit
Set objDoc = Nothing
Set objWord = Nothing
Next
Set folder = Nothing
Set fso = Nothing
End Sub
关于为什么要取得标题的长度还要再减1呢？因为这一行里面有一个回车符，有它在标题里面是不能保存word的。
在输入这篇文章的时候我很奇怪，为什么从ultraedit当中粘贴的代码就不能显示缩进，而从word 的 Microsoft Visual Basic中粘贴的就能显示缩进呢？可能是ultraedit中的缩进使用的是空格吧，而后者使用的是tab吧。
