从Excel工作表中只select一行（作为邮件合并的一部分）

我对VBA是全新的，我正在编写一个代码，将excel表格中每一行的合并数据发送到某个word文档，并将该文档的名称与每行的第一个单元格值相对应。

每行包含一个客户端的信息。 这就是为什么我必须邮寄每行信息分开。

到目前为止，代码工作正常，但我需要解决的两个问题：

1）在for循环的每次迭代中（循环遍历每一行）， SQLStatement:="SELECT * FROM Sheet1 $ "结束了来自表中所有行的邮件合并信息。 那么会发生什么呢，每个客户端的文档也包含其他客户端的数据（excel行）。

2）通常的自动化错误，除非我保持打开源文件。

那么有人可以告诉我如何从迭代已经到达的行中select信息。

我试过SQLStatement:="SELECT rw.row* FROM Sheet1 $ "但它不起作用

任何帮助将是好事。 完整的代码是：

 Sub RunMerge() 'booking document begins here Dim wd As Object Dim wdocSource As Object Dim activedoc Dim strWorkbookName As String Dim x As Integer Dim cdir As String Dim client As String Dim sh As Worksheet Dim rw As Range Dim rowcount As Integer Set sh = ActiveSheet For Each rw In sh.Rows If sh.Cells(rw.Row, 1).Value = "" Then Exit For End If cdir = "C:\Users\Kamlesh\Desktop\" client = Sheets("Sheet1").Cells(rw.Row + 1, 1).Value Dim newname As String newname = "Offer Letter - " & client & ".docx" 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 Const wdFormLetters = 0, wdOpenFormatAuto = 0 Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = -16 Set wdocSource = wd.Documents.Open("C:\Users\Kamlesh\Desktop\master\Regen-booking.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 `Sheet1$`" With wdocSource.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With wd.Visible = True wd.ActiveDocument.SaveAs cdir + newname 'wdocSource.Close SaveChanges:=False 'wd.Quit Set wdocSource = Nothing Set wd = Nothing Next rw End Sub 

我的Excel工作表看起来像这样

Answer 1

尝试这个。 显然这是未经testing，因为我不知道你的头名称和值

 SQLStatement:="SELECT * FROM `Sheet1$` WHERE SomeField = 'SomeUniqueValue'" 

就像是

 SQLStatement:="SELECT * FROM `Sheet1$` WHERE Client = " & Range("A" & rw + 1).Value & "'" 

1. 用实际的列replace“A”
2. 将“Client”replace为列的实际标题

另外就像我在下面的评论中提到的那样，为什么在循环中创build和销毁对象？ 您可以在For循环中实例化Word应用程序。 你可以将它从For循环中摧毁。

这是你正在尝试？ （ UNTESTED ）

按照您的要求，在下面的代码中更改sSQL = "SELECT * FROM Sheet1 $ WHERE [Client Name] = '" & .Range("A" & i).Value & "'"

 Const wdFormLetters = 0, wdOpenFormatAuto = 0 Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = -16 Sub RunMerge() Dim wd As Object, wdocSource As Object Dim sh As Worksheet Dim Lrow As Long, i As Long Dim cdir As String, client As String, newname As String Dim sSQL As String cdir = "C:\Users\Kamlesh\Desktop\" 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(cdir & "\master\Regen-booking.docx") Set sh = ActiveSheet strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name With sh Lrow = .Range("A" & .Rows.Count).End(xlUp).Row For i = 2 To Lrow If Len(Trim(.Range("A" & i).Value)) <> 0 Then client = .Cells(i, 1).Value newname = "Offer Letter - " & client & ".docx" wdocSource.MailMerge.MainDocumentType = wdFormLetters '~~> Sample String sSQL = "SELECT * FROM `Sheet1$` WHERE [Client Name] = '" & .Range("A" & i).Value & "'" wdocSource.MailMerge.OpenDataSource Name:=strWorkbookName, _ AddToRecentFiles:=False, Revert:=False, Format:=wdOpenFormatAuto, _ Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _ SQLStatement:=sSQL With wdocSource.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With wd.ActiveDocument.SaveAs cdir & newname wd.ActiveDocument.Close SaveChanges:=False End If Next i End With wdocSource.Close SaveChanges:=False wd.Quit Set wdocSource = Nothing Set wd = Nothing End Sub