邮件合并怎么分开成独立文档

juan68533

见附件
邮件合并，，全部文档会在一起，，想分成独立的文档。像附件中，，每两页做为一个独立文档，以学生的学号命名。。应如何操作

Admin

   

很遗憾通知楼上朋友，您的帖子在24小时之内没有任何回复！

通常情况下，本论坛发布的主题帖会在8小时被回复或处理。您的帖子在24小时之内未被回复，其中的原因可能是：

1、问题表述不清、模棱两可，难以理解，帮助者被搞晕了，夺帖而出；
2、没有上传必要的附件，或附件被遗忘在某个角落；
3、发帖提问时，语气带棱角、带挑衅，不幸被列入不受欢迎的帖子；
4、所提问题不成立，或提不合理的要求，乐于助人者使出“走为上”之计；
5、话题较偏、较冷或者发布到了不合适的版块，暂时无人问津，顾影自怜。


为了提高您的问题解决效率，我们推荐您阅读以下文章：
* 如何发表新话题和上传附件：http://club.excelhome.net/thread-45649-1-1.html
* 发帖的技巧：http://club.excelhome.net/thread-176339-1-1.html
* EH技术论坛的最佳学习方法：http://club.excelhome.net/thread-117862-1-1.html

juan68533

Sub SaveAsPages()
    Dim NumberPages As Integer, SAP As Byte, i As Integer
    Dim lngStart As Long, lngEnd As Long, myRange As Range
    Dim NewDoc As Document, FilName As String
    On Error GoTo Errhandle    '错误处理
    SAP = VBA.InputBox("请输入每个文件的分页数", "ExcelHome", Default:=1)
    With ThisDocument
        '取得本文档的总页数
        NumberPages = .Content.Information(wdNumberOfPagesInDocument)
        'MsgBox NumberPages
        '如果分页值大于总页数或者为0的整数则进入错误处理行
        If SAP > NumberPages Or SAP = 0 Then GoTo Errhandle
        Application.ScreenUpdating = False    '关闭屏幕更新
        '将分节符替换为分页符
        .Content.Find.Execute findtext:="^b", Replacewith:="^m", Replace:=wdReplaceAll
        For i = 1 To NumberPages Step SAP    '进行一个循环
            '取得第一个分页的起始位置
            lngStart = .GoTo(wdGoToPage, wdGoToNext, , i).Start
            '取得第一个分页的最后位置(是下一页的开始位置)
            lngEnd = VBA.IIf(i + SAP > NumberPages, .Content.End, .GoTo(wdGoToPage, wdGoToNext, , i + SAP).Start)
            '定义一个RANGE对象
            
            Set myRange = .Range(lngStart, lngEnd)
            '
            '取得文件名,为该RANGE区域中的第一个段落文本(去除段落标记)
            
            
            FilName = CInt(i)
            
           
            Set NewDoc = Documents.Add    '新建一个空白文档
            myRange.Copy    '复制
            With NewDoc
                .Range(0, 0).Paste    '起点处粘贴
                .Paragraphs.Last.Range.Delete    '删除最后一个段落标记(看情况)
                '                                Debug.Print FilName
               
               
                 With ActiveDocument.PageSetup
.TopMargin = CentimetersToPoints(2)
        .BottomMargin = CentimetersToPoints(0.6)
        .LeftMargin = CentimetersToPoints(3.2)
        .RightMargin = CentimetersToPoints(3.2)
.Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(0)
        .FooterDistance = CentimetersToPoints(0)
        .PageWidth = CentimetersToPoints(39)
        .PageHeight = CentimetersToPoints(28.5)
End With

               
                .SaveAs FilName    '另存为
                .Close    '关闭该文档
            End With
        Next
    End With
    Application.ScreenUpdating = True    '恢复屏幕更新
    Exit Sub
Errhandle:
    MsgBox "无效的分页数,请输入正确的数值!", vbExclamation, "ExcelHome"
    Application.ScreenUpdating = True
End Sub

曾经论坛里面有个守柔兄提供的程序，，，曾尝试及部分修改后，，对偶的文档可行。。。主要是文档命名还没解决，，因为原先守柔兄的程序行头是一小段文字可以提取当文档名，，而偶的不行，，所以命名只好用1.3.5.7来命名。

szqhb

俺不会
思路：按节拆分，提取“学号”及后面的数字命名。
应该是可以的