使用宏VBA从excel表创建单独的pdf

时间:2015-10-12 10:57:36

标签: vba pdf ms-word word-vba mailmerge

我正在尝试完成我的宏,但我不知道如何从我准备好的excel表(我的table = signle文档中的每一行)进行邮件合并。我写了这个宏,但它没有运行。第二件事是最终文件必须是pdf,我不知道要调整它。

Sub RunMerge()

    Dim wd As Object
    Dim wdocSource As Object

    Dim strWorkbookName As String

    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    If wd Is Nothing Then
        Set wd = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    Set wdocSource = wd.Documents.Open(ThisWorkbook.Path & "\" & "ArtSpecDatabase.docx")

    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    wdocSource.MailMerge.MainDocumentType = wdFormLetters

    wdocSource.MailMerge.OpenDataSource _
            Name:=strWorkbookName, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
            SQLStatement:="SELECT * FROM `Sheet2$`"

    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With

Dim PathToSave As String
PathToSave = ThisWorkbook.Path & "\" & "docs" & "\" & Sheets("Sheet2").Range("B2").Value2 & ".docx"
'PathToSave = "C:\Users\admin\Desktop\New folder (2)\docs\Merge_Mail_" & Replace(Replace(Now(), "/", "-"), ":", ".") & ".docx"
If Dir(PathToSave, 0) <> vbNullString Then
    wd.FileDialog(FileDialogType:=msoFileDialogSaveAs).Show
Else
    wd.ActiveDocument.SaveAs2 PathToSave, wdFormatDocumentDefault
End If

    wdocSource.Close SaveChanges:=False

    Set wdocSource = Nothing
    Set wd = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

您的代码中有MailMerge.Execute,它应该为数据库中的每条记录生成一个包含单个部分(可以是一个或多个页面)的新Word文档。这就是Word设计用于邮件合并的方式 - 没有内置功能来创建单独的文档。

如果您需要,那么您或者不需要使用邮件合并(还有其他技术可以为一组数据创建单独的文档),或者您需要拆分生成的文档。在过去的二十年中已经多次讨论过这个问题,并且有各种各样的方法可以解决这个问题。这里描述一个并使用Word的SubDocument功能: http://homepage.swissonline.ch/cindymeister/MergFram.htm

此处介绍了另一种方法: http://www.gmayor.com/individual_merge_letters.htm