批量提取某文件夹下的所有word文件的标题作为文件名

某文件夹下若干个word材料，名字为001—100，内容第一行都是材料标题，现想用标题命名文件怎么做？？怎么提取每个word里面的第一行或段出来？？

在线等高手，谢谢！

没人回答，最近一连问好几个问题都没人回答，哎，excelhome进入低谷？？？

原来一问，不到10分钟一般有回答的

Sub Word文件改名()
    Dim myS As String
    Selection.HomeKey wdStory
    Selection.EndKey wdLine
    Selection.HomeKey wdLine, wdExtend
    myS = Selection.Range.Text
    ActiveDocument.SaveAs FileName:="C:\" & myS & ".doc"
    ActiveWindow.Close
End Sub

搜索一下，很多答案的

简单做了一个，没有添加错误处理代码：

Sub SaveDoc()

   Dim P_Doc As Document, P_Path, str_Path As String, myRange As Range

   With Application.FileDialog(msoFileDialogFilePicker)

      .Title = "请选择被另存的Word文件"

      .AllowMultiSelect = True

      .Filters.Clear

      .Filters.Add "Word 文档", "*.doc"

          If .Show = -1 Then

             str_Path = CurDir & "\"

             For Each P_Path In .SelectedItems

                Set P_Doc = Documents.Open(FileName:=P_Path)

                Set myRange = P_Doc.Paragraphs(1).Range

                myRange.MoveEnd wdCharacter, -1

                P_Doc.SaveAs str_Path & myRange.Text

                P_Doc.Close

             Next

          End If

   End With

End Sub

谢谢两位大侠，请问chylhr，如果增加判断myrange为空啊？？为空就不能命名了，如果为空则取第二段，第二段也为空，就取第三段，谢谢

另外再帮我增加一个变量，获取原文件名，pname=原文件名，我自己有用， 谢谢

我用的是filesearch

paragraph和line不一样，如果第一段很长，这个文件名可能就长了。当然，如果第一段确保是标题也无所谓。

判断为空：if Len(ActiveDocument.Paragraphs(1).Range.Text)=1 then

获得文件名：

pname=ActiveDocument.Name