保存生成的Word文件的唯一名称（mailmerge）

我需要我的macros的帮助。 我需要通过邮件合并保存生成的Word文件。

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("C:\Users\admin\Desktop\New folder (2)\G706014 ver.7.0.docx") strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name wdocSource.Mailmerge.MainDocumentType = wdFormLetters wdocSource.Mailmerge.OpenDataSource _ Name:=strWorkbookName, _ AddToRecentFiles:=False, _ Revert:=False, _ Format:=wdOpenFormatAuto, _ Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _ SQLStatement:="SELECT * FROM `Mailing$`" With wdocSource.Mailmerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With wd.Visible = True wdocSource.Close SaveChanges:=False Set wdocSource = Nothing Set wd = Nothing End Sub 

这个macros只是生成文件，但不保存。

有人可以更新吗？

但是保存文件的名称必须是Excel文件，工作表mailing ，单元格A2的值

保存的目的地是： C:\Users\admin\Desktop\New folder (2)\docs

Answer 1

在你的代码中添加了这个：

 Dim PathToSave As String PathToSave = "C:\Users\admin\Desktop\New folder (2)\docs\" & Sheets("mailing").Range("A2").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 

以下是完整的代码：

 Sub RunMerge() Dim wd As Object, _ wdocSource As Object, _ PathToSave As String 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("C:\Users\admin\Desktop\New folder (2)\G706014 ver.7.0.docx") strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name wdocSource.MailMerge.MainDocumentType = wdFormLetters wdocSource.MailMerge.OpenDataSource _ Name:=strWorkbookName, _ AddToRecentFiles:=False, _ Revert:=False, _ Format:=wdOpenFormatAuto, _ Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _ SQLStatement:="SELECT * FROM `Mailing$`" With wdocSource.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With PathToSave = "C:\Users\admin\Desktop\New folder (2)\docs\" & Sheets("mailing").Range("A2").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 wd.Visible = True wdocSource.Close SaveChanges:=False Set wdocSource = Nothing Set wd = Nothing End Sub 

Answer 2

下面的代码应该允许您保存值单元格A2的基础

 Dim FileName As String Dim FilePath As String FilePath = "C:\Users\admin\Desktop\New folder (2)\" FileName = Sheets("mailing").Range("A2").Text & ".docx" ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName, _ OriginalFormat:=wdOriginalDocumentFormat