批量提取同一文件夹下多个word文档最后一页，形成独立的word文档

乔123321aa

文件夹下有多个word文档，附件举个例子是2个，假设实际是100个，需要分别提取每个word文档最后一页，形成新的独立的word，最终也是形成100个word。内容格式和原文档保持一直(含有的公式不变形)。如何用VBA解决

limonet

Sub limonet()
    Dim Path$, FileName$
    Path = ThisDocument.Path & "\"
    FileName = Dir(Path & "*.docx")
    Do While FileName <> ""
        If FileName <> "汇总.docm" Then
            Documents.Open (Path & FileName)
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=ActiveDocument.Windows(1).Panes(1).Pages.Count
            Selection.EndKey Unit:=wdStory, Extend:=wdExtend
            Selection.Copy
            ActiveDocument.Close False
            Selection.InsertBreak Type:=0
            Selection.PasteAndFormat (wdFormatOriginalFormatting)
        End If
        FileName = Dir
    Loop
End Sub

limonet

关键字：selection.goto

乔123321aa

limonet 发表于 2024-10-29 12:02
Sub limonet()
    Dim Path$, FileName$
    Path = ThisDocument.Path & "\"

老师确实厉害，但是这个结果我测试了是把最后一页进行汇总处理的，想要的是每一个word最后一页形成一个独立的word文档。

乔123321aa

limonet 发表于 2024-10-29 12:06
关键字：selection.goto

每一个word的最后一页形成的新的word文档的命名按照原文档名字+字符”--最后一页“

limonet

乔123321aa 发表于 2024-10-29 14:23
每一个word的最后一页形成的新的word文档的命名按照原文档名字+字符”--最后一页“

savecopyas

乔123321aa

limonet 发表于 2024-10-29 15:01
savecopyas

能再写一下代码吗

gwjkkkkk

乔123321aa 发表于 2024-10-29 15:15
能再写一下代码吗

先评分，再提条件。

乔123321aa

gwjkkkkk 发表于 2024-11-3 15:18
先评分，再提条件。

不好意思，我自己用R语言解决了，就不评分了，下次再给你评个满分哈。

过客fppt

乔123321aa 发表于 2024-11-4 09:32
不好意思，我自己用R语言解决了，就不评分了，下次再给你评个满分哈。

厉害，别人都好心帮助过你了，你就不评分了。一句话寒了多少个热心人的心