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

plg123

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

在线等高手，谢谢！

plg123

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

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

wdwc

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

搜索一下，很多答案的

[此贴子已经被作者于2008-5-8 10:43:15编辑过]

chylhr

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

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

 

plg123

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

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

[此贴子已经被作者于2008-5-11 9:40:39编辑过]

plg123

继续顶上去，有人帮忙回答不？？

wdwc

我用的是filesearch

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

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

获得文件名：

pname=ActiveDocument.Name

szqhb

原帖由 chylhr 于 2008-5-11 00:15 发表
简单做了一个，没有添加错误处理代码：Sub SaveDoc()   Dim P_Doc As Document, P_Path, str_Path As String, myRange As Range   With Application.FileDialog(msoFileDialogFilePicker)  ...

做个记号先

dsital

没有看明白，能不能上传个附件。

eh蝴蝶效应

chylhr 发表于 2008-5-11 00:15
简单做了一个，没有添加错误处理代码：Sub SaveDoc()   Dim P_Doc As Document, P_Path, str_Pat ...

测试了老师的代码，确实可以成功。
但是，文件夹中只要有一个空文档，就全部操作不下去了。
期待有一个检测是否有空文档的判断。