1

Тема: метод Слияние, сохранить в новых файлах с уникальным названием

Подскажите какой макрос можно вставить в файл слияние для сохранения каждой записи в новый файл PDF с уникальным названием "Исходящий номер". Исходящий номер - уникальный присваивается каждой записи в файле EXCEL и используется в шаблоне документа как исходящий номер письма.

Спасибо.

Post's attachments

Письма Исх.rar 36.08 Кб, 11 скачиваний с 2010-09-10 

You don't have the permssions to download the attachments of this post.

2

Re: метод Слияние, сохранить в новых файлах с уникальным названием

Давно меня интересовал этот вопрос, но не было необходимости и времени. Теперь время нашлось, и, оказалось, это не так сложно: нужно всего лишь программно пройтись по записям, отправляя каждую из них в отдельный документ, а затем этот документ сохранить.
Текст, который нужно использовать в имени файла, нужно поместить в закладку, а имя закладки записать в константу OUTGOING

Sub SaveEachMergeToFile()
  Dim oMergedDoc As Document
  Const OUTGOING As String = "number"
  If ActiveDocument.MailMerge.MainDocumentType <> wdNotAMergeDocument Then
    Set oMergedDoc = ActiveDocument
  Else
    MsgBox "Активный документ должен быть создан слиянием.", vbExclamation, "Сохранение документов после слияния"
    Exit Sub
  End If
  If Not oMergedDoc.Bookmarks.Exists(OUTGOING) Then
    MsgBox "В документе нет закладки с именем " & OUTGOING & ", которая используется в качестве имени файла." & vbNewLine & _
          "Создайте закладку с таким именем и запустите макрос ещё раз", vbExclamation, "Сохранение документов после слияния"
    Exit Sub
  End If
  
  oMergedDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord
  
  Dim i As Integer
  With oMergedDoc.MailMerge
    For i = 1 To .DataSource.RecordCount
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = .ActiveRecord
        .LastRecord = .ActiveRecord
      End With
      .Execute False
      With Documents(1)
        .SaveAs oMergedDoc.Path & "\" & oMergedDoc.Bookmarks(OUTGOING).Range.Text
        .Close False
      End With
      .DataSource.ActiveRecord = wdNextRecord
      DoEvents
    Next
  End With
  
  MsgBox "Все документы слияния сохранены в папку """ & oMergedDoc.Path & """", vbInformation, "Сохранение документов после слияния"
End Sub
Лучше день потерять — потом за пять минут долететь!

3

Re: метод Слияние, сохранить в новых файлах с уникальным названием

Ой, вам в pdf нужно…Тогда строчку:

.SaveAs oMergedDoc.Path & "\" & oMergedDoc.Bookmarks(OUTGOING).Range.Text

замените на

.ExportAsFixedFormat oMergedDoc.Path & "\" & oMergedDoc.Bookmarks(OUTGOING).Range.Text, wdExportFormatPDF

Для правильной работы должна быть установлена надстройка для сохранения в формате PDF

Лучше день потерять — потом за пять минут долететь!

4

Re: метод Слияние, сохранить в новых файлах с уникальным названием

А если для 2003 офиса? Если установлен виртуальный принтер?

5

Re: метод Слияние, сохранить в новых файлах с уникальным названием

Тогда ещё проще: сохранять не нужно, а просто отправить на печать, только вот имя файла задать не получится.

Лучше день потерять — потом за пять минут долететь!

6

Re: метод Слияние, сохранить в новых файлах с уникальным названием

viter.alex пишет:

Ой, вам в pdf нужно…Тогда строчку:

.SaveAs oMergedDoc.Path & "\" & oMergedDoc.Bookmarks(OUTGOING).Range.Text

замените на

.ExportAsFixedFormat oMergedDoc.Path & "\" & oMergedDoc.Bookmarks(OUTGOING).Range.Text, wdExportFormatPDF

Для правильной работы должна быть установлена надстройка для сохранения в формате PDF

Александр! большое СПАСИБО! Все работает, теперь высвободилось много времени ...
единственное , выдавало ошибку "Неверное имя файла" строка :  .ExportAsFixedFormat oMergedDoc.Path & "\" & oMergedDoc.Bookmarks(OUTGOING).Range.Text, wdExportFormatPDF

Я заменил \ на \\ , и все сохраняется... еще раз огромное спасибо!

7

Re: метод Слияние, сохранить в новых файлах с уникальным названием

imaslov, чисто ради эксперимента, впишите вместо "\" выражение Application.PathSeparator и доложите об итогах

Лучше день потерять — потом за пять минут долететь!

8

Re: метод Слияние, сохранить в новых файлах с уникальным названием

viter.alex пишет:

imaslov, чисто ради эксперимента, впишите вместо "\" выражение Application.PathSeparator и доложите об итогах

работает. сохраняет в туже папку , где шаблон
Александр, я Вам написал в Аську, ответьте пожалуйста.

9

Re: метод Слияние, сохранить в новых файлах с уникальным названием

Наткнулась на ваш форум пытаясь решить проблему сохранения по отдельности в pdf файлов письма, создаваемых слиянием.
Попыталась разобраться по с приведенным скриптом, дошла до момента когда он как бы сохраняет, но по факту нет файлов.

Sub SaveEachMergeToFile()
  Dim oMergedDoc As Document
  Const OUTGOING As String = "number"
  If ActiveDocument.MailMerge.MainDocumentType <> wdNotAMergeDocument Then
    Set oMergedDoc = ActiveDocument
  Else
    MsgBox "Активный документ должен быть создан слиянием.", vbExclamation, "Сохранение документов после слияния"
    Exit Sub
  End If
  If Not oMergedDoc.Bookmarks.Exists(OUTGOING) Then
    MsgBox "В документе нет закладки с именем " & OUTGOING & ", которая используется в качестве имени файла." & vbNewLine & _
          "Создайте закладку с таким именем и запустите макрос ещё раз", vbExclamation, "Сохранение документов после слияния"
    Exit Sub
  End If
  
  oMergedDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord
  
  Dim i As Integer
  With oMergedDoc.MailMerge
    For i = 1 To .DataSource.RecordCount
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = .ActiveRecord
        .LastRecord = .ActiveRecord
      End With
      .Execute False
      With Documents(1)
        .ExportAsFixedFormat oMergedDoc.Path & "Application.PathSeparator" & oMergedDoc.Bookmarks(OUTGOING).Range.Text, wdExportFormatPDF
        .Close False
      End With
      .DataSource.ActiveRecord = wdNextRecord
      DoEvents
    Next
  End With
  
  MsgBox "Все документы слияния сохранены в папку """ & oMergedDoc.Path & """", vbInformation, "Сохранение документов после слияния"
End Sub

10

Re: метод Слияние, сохранить в новых файлах с уникальным названием

Xenia1704 пишет:

Наткнулась на ваш форум пытаясь решить проблему сохранения по отдельности в pdf файлов письма, создаваемых слиянием.
Попыталась разобраться по с приведенным скриптом, дошла до момента когда он как бы сохраняет, но по факту нет файлов.

Sub SaveEachMergeToFile()
  Dim oMergedDoc As Document
  Const OUTGOING As String = "number"
  If ActiveDocument.MailMerge.MainDocumentType <> wdNotAMergeDocument Then
    Set oMergedDoc = ActiveDocument
  Else
    MsgBox "Активный документ должен быть создан слиянием.", vbExclamation, "Сохранение документов после слияния"
    Exit Sub
  End If
  If Not oMergedDoc.Bookmarks.Exists(OUTGOING) Then
    MsgBox "В документе нет закладки с именем " & OUTGOING & ", которая используется в качестве имени файла." & vbNewLine & _
          "Создайте закладку с таким именем и запустите макрос ещё раз", vbExclamation, "Сохранение документов после слияния"
    Exit Sub
  End If
  
  oMergedDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord
  
  Dim i As Integer
  With oMergedDoc.MailMerge
    For i = 1 To .DataSource.RecordCount
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = .ActiveRecord
        .LastRecord = .ActiveRecord
      End With
      .Execute False
      With Documents(1)
        .ExportAsFixedFormat oMergedDoc.Path & "Application.PathSeparator" & oMergedDoc.Bookmarks(OUTGOING).Range.Text, wdExportFormatPDF
        .Close False
      End With
      .DataSource.ActiveRecord = wdNextRecord
      DoEvents
    Next
  End With
  
  MsgBox "Все документы слияния сохранены в папку """ & oMergedDoc.Path & """", vbInformation, "Сохранение документов после слияния"
End Sub

Ксения, попробуйте использовать для сохранения файла что-то вроде:

ActiveDocument.SaveAs2 FileName:="aaa.docx"
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.