求救：word批量命名：用word内容首行命名！

Question

如何将word批量命名word文件名自动改成文档的首行的内容？有相关软件或vba的话麻烦发给我，谢谢

Answer 1

你好，批量给文件命名需要借助相关工具进行，具体操作如下：

1、点击添加文件把我们的文件一一添加进来。

2、在界面右侧设置中可以修改文件名的前缀后缀等，并可以在图中圈中位置预览

3、点击重命名即可

追问

哥，这是什么软件？

Answer 2

试试这款。选择其提取首段非空段重命名。

或者这款：

Answer 3

这个，我刚好会。
不过，准备一点来说，对WORD内容有几点要求。
一，首行不能是图片和表格等非文字性内容。
二，若首行是空行，继续读取下一行，直到内容非空时取为文件名。
VBS程序已经发给你了。希望该程序能使你办公效率大增。
祝贵人工作顺利！

Answer 4

我可以帮你开发个读取写出重命名的

Answer 5

亲测可用，粘贴到文本文档，然后复制进去，另存为，后缀名改成vbs。要改哪的文档，就把这个复制到那个文件夹里面。好不容易找到的，希望下次搜的人也能找到：缺点就是遇到错误的情况不会跳过，不会整。如果有大神看到了，请丰富一下代码。
Dim fso,fc,f,strName
Set fso = CreateObject("scripting.filesystemobject")
Set fc=fso.GetFolder(".").Files
For Each f In fc
If LCase(fso.GetExtensionName(f))="doc" Then
f.Name=GetFileName(f.Path) & ".docx"
End If
If LCase(fso.GetExtensionName(f))="docx" Then
f.Name=GetFileName(f.Path) & ".docx"
End If
Next
Set fso=Nothing

Function GetFileName(FilePath)
Dim i,objWord,Doc
Set objWord=CreateObject("word.application")
Set Doc=objWord.Documents.Open(FilePath)
For i=1 To Doc.Paragraphs.Count
If Replace(Doc.Paragraphs(i).Range," ","")<>vbCr Then
GetFileName=Replace(Doc.Paragraphs(i).Range,vbCr,"")
Exit For
End If
Next
objWord.Quit
Set objWord=Nothing
End Function