|
My Computer:WinXP SP2+Office 2003 SP2
我有很多word文档放在文件夹内，文件名是无规律的，现在想用文件的首行来重命名文件。（若首行为空行先删除空行）
在网站上找到了一个答案，但是不知道怎么调试。因为没有编程经验，对VBA，VBE也不熟悉，请高手指点。
PS：下面的编程语句放在word宏里，我没法打开宏得到结果，请顺便告知要是语句能实现的话，是不是能批处理某个文件夹里的所有word文档的？
Sub ReNameDoc() '此代码功能为列出重命令指定文件夹中所有选取的WORD文件
'声明变量
Dim MyDialog As FileDialog, vrtSelectedItem As Variant, A As Byte, MyDoc As Document
Dim OldName As String, NewName As String, MyRange As Range
'当一个运行时错误发生时，控件转到紧接着发生错误的语句之后的语句，并在此继续运行
On Error Resume Next
'定义一个文件夹选取对话框
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add "所有WORD文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True '允许多项选择
If .Show = -1 Then '确定
For Each vrtSelectedItem In .SelectedItems '在所有选取项目中循环
Set MyDoc = Documents.Open(FileName:=vrtSelectedItem, Visible:=False)
OldName = vrtSelectedItem '取得原文件名
Debug.Print OldName
For A = 1 To 10 '循环
Set MyRange = MyDoc.Paragraphs(A).Range
If Len(MyRange.Text) > 1 Then
Exit For '如果该段落文本长度大小于(非空白段落),则退出循环
If MyRange.Information(wdWithInTable) Then '如果在表格中,则去除最后两个字符
NewName = Mid(MyRange.Text, 1, Len(MyRange.Text) - 2)
Else '如果为正常段落不在表格中,则去除最后一个段落标记
NewName = Mid(MyRange.Text, 1, Len(MyRange.Text) - 1)
End If
MyDoc.Close False '关闭文件
'去除空格
NewName = VBA.Trim(NewName) '重新定义新的文件名
NewName = .InitialFileName & NewName '如果已经存在该文件名,则加上时间数,加以区别
If Dir(NewName & ".Doc", vbDirectory) <> "" Then
NewName = NewName & Timer '重命名该文件
Name OldName As NewName & ".Doc"
Else
End If
End With
End Sub | 
