word重命名如何换行

1.如何将word批量命名word文件名自动改成文档的首行的内容?

Sub ChangeDocName(sPath As String)

Dim wdApp

Dim oDoc

Dim sFileName As String

Dim sNewName As String

Dim i As Integer

On Error Resume Next

Set wdApp = CreateObject("Word.Application")

On Error GoTo 0

If wdApp Is Nothing Then

MsgBox "创建word实例失败，程序将退出。本程序只能在装有word程序的电脑上运行。"

Exit Sub

End If

If Right(sPath, 1) "\" Then sPath = sPath & "\"

sFileName = Dir(sPath & "*.doc", vbHidden + vbSystem)

Do While sFileName ""

i = 0

Set oDoc = wdApp.Documents.Open(sapth & sFileName)

oDoc.Select

wdApp.Selection.HomeKey Unit:=wdStory

wdApp.Selection.Expand wdLine

sNewName = wdApp.Selection.Text

sNewName = Replace(sNewName, "\", "")

sNewName = Replace(sNewName, "/", "")

sNewName = Replace(sNewName, ":", "")

sNewName = Replace(sNewName, "?", "")

sNewName = Replace(sNewName, "*", "")

sNewName = Replace(sNewName, ">", "")

sNewName = Replace(sNewName, "sNewName = Replace(sNewName, """", "")

oDoc.Close

Err.Clear

On Error GoTo FileAlreadyExist

Name sPath & sFileName As sPath & sNewName & ".doc"

FileAlreadyExist:

If Err.Number >0 Then

i = i + 1

Name sPath & sFileName As sPath & sNewName & i & ".doc"

End If

On Error GoTo 0

sFileName = Dir()

Loop

Set wdApp = Nothing

End Sub

上述代码中已经加入了常见错误的处理，使用的时候将文件夹的完整路径作为参数输入就可以了。