Пропустить MS Word Mail Merge, если в источнике данных нет записей - PullRequest
0 голосов
/ 09 февраля 2019

В настоящее время у меня есть 6 шаблонов слияния, которые я выполняю через следующие vbs.

, при этом открывается каждый файл в корневой папке и запускается mailmerge,

VBS

 Set fs = CreateObject("Scripting.FileSystemObject")
    Set rootFolder = fs.GetFolder(fs.GetParentFolderName(wscript.ScriptFullName))
    Set oWord = Createobject("Word.Application")
        oWord.Visible = False

    For Each file in rootFolder.Files
       If LCase(fs.GetExtensionName(file.Name)) = "docx" Then
        Set oDocument = oWord.Documents.Open(file.path)
            oWord.Run "regular_mail"
            oDocument.Close(False)
        Set oDocument = Nothing
       End If
    Next
    oWord.Quit
    set oWord = nothing

внутреннее слово vba, помещает ли mailmerge его в указанную папку, и я получаю сообщение об ошибке, когда источник данных для этого файла не содержит данных.так как StrName = .DataFields("pk") не будет иметь никаких значений.

Где я застрял, как обойти эту ошибку или проверить, не является ли источник данных пустым, а затем перейти к следующему шаблону.

каждый шаблон должен быть сохранен в один файл, чтобы мой почтовый отдел мог распечатать.

VBA в слове:

Sub regular_mail()
Dim sDate As String, StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long, fso As Object, StrMonthPath As String, StrDayPath As String, StrFileName As String

sDate = Format(Now(), "mmddyy")
Const StrFolderName As String = "C:\Test\Files\"
Set fso = CreateObject("Scripting.FileSystemObject")

    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True

        With .DataSource
            .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i

            StrName = .DataFields("pk")
            StrMonthPath = .DataFields("month_path")
            StrDayPath = .DataFields("day_path")
            StrSendDate = .DataFields("send_date")
            StrFileName = sDate & "_" & fso.GetBaseName(ActiveDocument.Name)
        End With
        .Execute Pause:=False



'Creates directory if it doesnt exist

    If Not fso.FolderExists(StrFolderName & StrMonthPath) Then
        fso.CreateFolder (StrFolderName & StrMonthPath)
    End If

    If Not fso.FolderExists(StrFolderName & StrMonthPath & StrDayPath) Then
        fso.CreateFolder (StrFolderName & StrMonthPath & StrDayPath)
    End If


    If Not fso.FolderExists(StrFolderName & StrMonthPath & StrDayPath & "letters\") Then
        fso.CreateFolder (StrFolderName & StrMonthPath & StrDayPath & "letters\")
    End If
    End With



    ActiveDocument.SaveAs2 FileName:=StrFolderName & StrMonthPath & StrDayPath & "letters\" & StrFileName, FileFormat:=16, AddToRecentFiles:=False

    ActiveWindow.Close
End Sub

любая помощь приветствуется, спасибо заранее.

1 Ответ

0 голосов
/ 09 февраля 2019

Не имея возможности проверить это прямо сейчас, вы можете использовать оба или один из следующих подходов:

Вы можете проверить это DataSource - это ничто (или, если не Ничто, как вам нужно):

If .DataSource Is Nothing Then ...

Вы можете проверить, есть ли записи в источнике данных:

If .DataSource.RecordCount = 0 Then
...