VBA获取word文档标题内容，并把文件名改为标题名

AKNIER

如下图，一个word文档中有2个标题1，需要一个VBA把文件名改成“标题1&标题2”，

AKNIER

附件.rar (12.65 KB, 下载次数: 65)

2018-2-27 21:16 上传

点击文件名下载附件

查了论坛的一些帖子，还是不会，希望得到帮助，这个对我很有用，

xiaoyouxi01

暂时以楼主提供的附件，写了段简单代码，楼主可以自己试试~

1. Sub 宏1()
   
2.     Dim path As String, filename As String, i As Integer
   
3.     For i = 1 To ActiveDocument.Paragraphs.Count
   
4.         If ActiveDocument.Paragraphs(i).Style = "标题 1" Then
   
5.             filename = filename & "&" & ActiveDocument.Paragraphs(i).Range
   
6.         End If
   
7.     Next i
   
8.     path = "C:"
   
9.     filename = Replace(Mid(filename, 2), vbCr, "")
   
10.     ActiveDocument.SaveAs2 filename:=path & filename & ".docx"
    
11. End Sub

复制代码

贴在上面的这个代码，path = "C:\" 这句里的斜杠不知道怎么回事显示不出来。。再贴一个在下面~

Sub 宏1()
    Dim path As String, filename As String, i As Integer
    For i = 1 To ActiveDocument.Paragraphs.Count
        If ActiveDocument.Paragraphs(i).Style = "标题 1" Then
            filename = filename & "&" & ActiveDocument.Paragraphs(i).Range
        End If
    Next i
    path = "C:\"
    filename = Replace(Mid(filename, 2), vbCr, "")
    ActiveDocument.SaveAs2 filename:=path & filename & ".docx"
End Sub

AKNIER

xiaoyouxi01 发表于 2018-2-27 22:37
暂时以楼主提供的附件，写了段简单代码，楼主可以自己试试~

谢谢，昨天晚上论坛有高人联系我了，附上代码大家一起学习
Sub test2()
    Dim pa As Paragraph, mystr$
    For Each pa In ActiveDocument.Paragraphs
        If pa.Style = "标题 1" Then mystr = mystr & "&" & Left(pa.Range.Text, Len(pa.Range) - 1)
    Next
   
    mystr = Mid(mystr, 2, Len(mystr))
    ActiveDocument.SaveAs ActiveDocument.Path & "\" & mystr & ".doc", FileFormat:=wdFormatDocument
    ActiveDocument.Close 0
End Sub

duquancai

AKNIER 发表于 2018-2-28 08:52
谢谢，昨天晚上论坛有高人联系我了，附上代码大家一起学习
Sub test2()
    Dim pa As Paragraph, myst ...

一看就不像我写的代码，哈哈！因为20元，完全就是对技术的亵渎！

AKNIER

我是菜鸟，不懂，至少解决了我的问题，谢谢各位的回复！

413191246se

楼主只要会用 VBA 宏代码，就好办了！论坛上会有不少朋友帮助你的。

dywcb

我用类似的程序修改文件名并另存，但是最后弹出“运行时错误，5487，由于文件许可错误，Word无法完成保存。”，但是如果我直接输入文件路径和文件名进行保存，不用str传递文件名是可以成功修改文件名并另存的。有大神知道是什么原因，如何解决吗？