Автоматическое слияние писем с помощью Excel VBA

Question

Меня зовут Хема, и это мой первый макрос и первое сообщение в переполнении стека.

Я создал макрос в Excel, где я могу автоматически сбрасывать данные из Excel в Word Letter Template и сохранять отдельные файлы в папке.

У меня есть данные Employee в Excel, и я могу сгенерировать любое письмо сотрудника, используя эти данные, и сохранить индивидуальное письмо сотрудника в соответствии с именем Employee.

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

Теперь единственная проблема, с которой я столкнулся - это выход во всех объединенных файлах, выход такой же, как и в первой строке. Пример: если мой Excel имеет 5 сведений о сотрудниках, я могу сохранить 5 отдельных объединенных файлов для каждого имени сотрудника, однако объединенные данные, если у первого сотрудника, который находится только в строке 2. Во всех файлах данные отображаются для первого сотрудника строки.

Я не мог прикреплять файлы, но мои строки имеют следующие данные: Строка A: имеет S.No. Ряд B: имеет Empl Имя Ряда C: имеет Обработку Дата Ряд D: есть Адрес Ряд E: Firstname Ряд F: бизнес Название Ряд G: Показывает состояние (если письмо генерируется он показывает «Письмо Сформировано уже «после запуска макроса или он отображается пустым, если введена новая запись.

Также попросите кого-нибудь добавить код, в котором я могу сохранить вывод (объединенный файл) также в PDF, отличном от DOC-файла. быть в двух форматах один в Doc, а другой - в форматах PDF.

Большое спасибо в Advance надеемся немного послушать кого-то.

Sub MergeMe() 
Dim bCreatedWordInstance As Boolean 
Dim objWord As Word.Application 
Dim objMMMD As Word.Document 
Dim EmployeeName As String 
Dim cDir As String 
Dim r As Long 
Dim ThisFileName As String 
lastrow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row 
r = 2 
For r = 2 To lastrow 
If Cells(r, 7).Value = "Letter Generated Already" Then GoTo nextrow 
EmployeeName = Sheets("Data").Cells(r, 2).Value 

' Setup filenames 
Const WTempName = "letter.docx" 'This is the 07/10 Word Templates name, Change as req'd 
Dim NewFileName As String 
NewFileName = "Offer Letter - " & EmployeeName & ".docx" 'This is the New 07/10 Word Documents File Name, Change as req'd" 

' Setup directories 
cDir = ActiveWorkbook.path + "\" 'Change if appropriate 
ThisFileName = ThisWorkbook.Name 

On Error Resume Next 

' Create a Word Application instance 
bCreatedWordInstance = False 
Set objWord = GetObject(, "Word.Application") 

If objWord Is Nothing Then 
    Err.Clear 
    Set objWord = CreateObject("Word.Application") 
    bCreatedWordInstance = True 
End If 

If objWord Is Nothing Then 
MsgBox "Could not start Word" 
Err.Clear 
On Error GoTo 0 
Exit Sub 
End If 

' Let Word trap the errors 
On Error GoTo 0 

' Set to True if you want to see the Word Doc flash past during construction 
objWord.Visible = False 

'Open Word Template 
Set objMMMD = objWord.Documents.Open(cDir + WTempName) 
objMMMD.Activate 

'Merge the data 
With objMMMD 
.MailMerge.OpenDataSource Name:=cDir + ThisFileName, sqlstatement:="SELECT * FROM `Data$`" ' Set this as required 

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

' Save new file 
objWord.ActiveDocument.SaveAs cDir + NewFileName 

' Close the Mail Merge Main Document 
objMMMD.Close savechanges:=wdDoNotSaveChanges 
Set objMMMD = Nothing 

' Close the New Mail Merged Document 
If bCreatedWordInstance Then 
objWord.Quit 
End If 

0: 
Set objWord = Nothing 
Cells(r, 7).Value = "Letter Generated Already" 
nextrow: 

Next r 
End Sub 

С уважением, Hema

Answer 1

Чтобы сохранить файл в использовании Формат PDF

objWord.ActiveDocument.ExportAsFixedFormat cDir & NewFileName, _ 
        ExportFormat:=wdExportFormatPDF 

Мне кажется, что, когда вы выполняете слияние почты, он должен создать файл с ВСЕ буквы, поэтому, когда вы откроете его, появится первая буква, которая будет сохранена, но если вы прокрутите вниз файл слова, который вы сохранили, вы можете найти каждое письмо на новой странице.

Вместо этого вы хотите выполнить слияние по одной букве за раз.
Чтобы это исправить, изменить строки следующим образом:

With .DataSource 
    .FirstRecord = r-1 
    .LastRecord = r-1 
    .ActiveRecord = r-1 

Вы должны использовать r-1, потому что Слово будет использовать номер записи в наборе данных, и поскольку данные начинается в строке 2, а счетчик r относится к строке, вам нужно r-1.

Вам не нужно открывать слово каждый раз, поэтому поместите весь код, задающий источник данных слияния, и создайте слово doc вне основного цикла.

Const WTempName = "letter.docx" 'This is the 07/10 Word Templates name, 
Dim NewFileName As String 

' Setup directories 
cDir = ActiveWorkbook.path + "\" 'Change if appropriate 
ThisFileName = ThisWorkbook.Name 

On Error Resume Next 

' Create a Word Application instance 
bCreatedWordInstance = False 
Set objWord = GetObject(, "Word.Application") 

If objWord Is Nothing Then 
    Err.Clear 
    Set objWord = CreateObject("Word.Application") 
    bCreatedWordInstance = True 
End If 

If objWord Is Nothing Then 
    MsgBox "Could not start Word" 
    Err.Clear 
    On Error GoTo 0 
    Exit Sub 
End If 

' Let Word trap the errors 
On Error GoTo 0 

' Set to True if you want to see the Word Doc flash past during construction 
objWord.Visible = False 

'Open Word Template 
Set objMMMD = objWord.Documents.Open(cDir + WTempName) 
objMMMD.Activate 

'Merge the data 
With objMMMD 
.MailMerge.OpenDataSource Name:=cDir + ThisFileName, _ 
    sqlstatement:="SELECT * FROM `Data$`" ' Set this as required 

For r = 2 To lastrow 
    If Cells(r, 7).Value = "Letter Generated Already" Then GoTo nextrow 
'rest of code goes here 

Кроме того, вместо проверки файла Excel для имени Сотрудника для создания имени файла, вы можете сделать это после слияния документа. Для меня это немного интуитивно, чтобы связать имя файла с письмом, которое вы только что объединили. Для того, чтобы сделать это обновление линии дальше:

With .DataSource 
    .FirstRecord = r-1 
    .LastRecord = r-1 
    .ActiveRecord = r-1 
    EmployeeName = .EmployeeName 'Assuming this is the field name 

Затем непосредственно перед сохранением файла вы можете сделать это:

' Save new file 
NewFileName = "Offer Letter - " & EmployeeName & ".docx" 
objWord.ActiveDocument.SaveAs cDir + NewFileName 

Надеется, что это помогает.