We help IT Professionals succeed at work.

Deleting Blank Rows Before Email Merge


Trying to delete rows in a table before mail merge.  Not wanting to delete rows in the template.  Getting hung up... what am I missing??

Sub DeleteRows()

  Dim d As Document, t As Table, t1 As Table
  Dim TargetText As String
  Dim oRow As Row
  Set d = ActiveDocument

  ' commented out If Selection.Information(wdWithInTable) = False Then Exit Sub

  TargetText = "DELETE" 'InputBox$("Enter target text:", "Delete Rows")
    For Each t In d.Tables
          ' commented out For Each t1 In t.Tables
            For Each oRow In t.Rows
                If InStr(oRow.Cells(1).Range.Text, TargetText) = 1 Then oRow.Delete
            Next
        ' commented out Next
    Next
End Sub
Sub MergeWithDelete()
'
' MergeWithDelete Macro
'
'
'    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        ' Call DeleteRows
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        Call DeleteRows
        .Execute Pause:=False
    End With
End Sub
Comment
Watch Question

the deleterows() code does work as expected, thus deletes the rows from what i guess will be seen as the template.

You could copy the tables to a temporary document and re-insert them after the mailmerge process to overwrite the tables which might have deleted rows.

Author

Commented:
Basically, the macro is working fine when I mail merge and then say I want to to edit individual documents.  After the whole thing merges, I run the macro and it takes out all the rows I need.  NOW my problem is, I need to email the letters - - SO, I figured I have two options (don't know how to do either) but may be missing something else.

1.  Run the mail merge as an email mail merge but somehow get the mail merge to auto-execute the macro prior to kicking off the email for each individual.

2.  Run the mail merge and delete rows macro as normal and figure out a way to email each person their own letter from the one large file (which is over 1800 pages).

Any ideas?
I may have misunderstood the meaning of the deleted rows.
Are the rows that you want to delete parts of the content of the merged documents that are sent to each person, or are the deleted rows containing all merge data for a specific person ?

Author

Commented:
When the mail merge completes, the rows in the table that should be deleted say Delete.  The macro finds those rows and deletes them.  So when I run the mail merge for letters, I do the mail merge, then I run the macro and it deletes all the proper rows.  However, when I want to send as an email, I would need it to merge for a person, run the macro for each person and email that persons results and then proceed to the next.  Make sense?
So at the end of the mail merge process the macro is called and deletes all unnecessary rows in each resulting document (letter).
You are looking for a way to either run the macro during an email-merge process (just before sending the emails) or update the macro such that after a letter-merge process the rows are deleted and emails are sent.


right ?

Author

Commented:
Yes, that is exactly what I need!

Author

Commented:
I'm wondering if it is a loop problem...  
I am currently very busy at work so it could take a while but i am working on it...

Author

Commented:
Any news on a solution?  I am reaching desperation point as I have to send this file in the next few days.  Anyone have a brilliant idea?
I believe this should do the trick ...
Sub MergeWithDelete2()

    With ThisDocument.MailMerge
        .DataSource.ActiveRecord = wdFirstRecord
        For Item = 1 To .DataSource.RecordCount
            .DataSource.ActiveRecord = Item
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = .ActiveRecord
                .LastRecord = .ActiveRecord
            End With
            Call DeleteRows
            .Execute Pause:=False
        Next Item
    End With

End Sub

Open in new window

when you are confident that the results match your expectations, you can update line 7 to
.Destination = wdSendToEmail

Open in new window

in order to send the results by email.

Author

Commented:
This appears to be ALMOST exactly what we need (thank you) -- however, when I replaced line 7 with the line above, I received a run time error 5630

Word cannot merge documents that can be distributed by mail or fax without a valid mail address.  Choose the setup button to select a mail address data field.

Can you help decipher?

Author

Commented:
Okay - - one final update - - finally got the email to work - - YEAH but big problem - - because DeleteRows macro is running in between each record - - it deleted rows from the original letter - - so on the next record, those lines were not available to merge.  I need to restore the document to it's original format between each record!  Any line of code that can do that?
sorry, I forgot about that !

easily changed by by using this code :
Sub MergeWithDelete2()

    With ThisDocument.MailMerge
        .DataSource.ActiveRecord = wdFirstRecord
        For Item = 1 To .DataSource.RecordCount
            .DataSource.ActiveRecord = Item
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = .ActiveRecord
                .LastRecord = .ActiveRecord
            End With
            .Execute Pause:=False
            Call DeleteRows
            Call SendEmail
        Next Item
    End With

End Sub

Open in new window


as you can see code has not changed much but the deleterows function is called after executing the mail merge function.
Only problem is that this will only work when new documents have been mailmerged, to the SendEmail function is added to perform the actual sending of the documents. Elaborate on this code :
Sub SendEmail()

Set outlookApp = CreateObject("Outlook.Application")
Set outlookMail = outlookApp.CreateItem(olMailItem)

With outlookMail 
   .To = "name@domain.com"
   .Subject = "email subject"
   .Body = ActiveDocument.Content.Text
   .Send
End With

End Sub

Open in new window




Author

Commented:
this is good code because the delte rows is working and the send is working, but then it is still deleting all the rows in the template cumulatively. what we need is to have a new doc, remove the appropriate rows, send, then create a new doc with all the original rows from the template.  Is there a way to create a new document with all of the rows from the template?  Do you think instead of mail merge we should create a looping new doc for each record?  (not that I know how to do this).
The delete macro works on the document that is active at the moment the routine is called.
The mailmerge (at least when destination is still set to wdSendToNewDocument) generates a new document which gets focus after the .execute statement has been fired.
Because of the call deleterows statement being placed directly after the mailmerge.execute statement, it should delete the rows from the freshly mail-merged new document and not from the template.

At my workplace this indeed is the case, the template itself is not harmed.
If at your place the template is harmed, you could try to place a
DoEvents

Open in new window

line in between the ".execute" and the "call deleterows"  code rows.
Switching to a loop to copy the template into a new document and replace certain tagholders with information from a table is not that hard, but in order to get this done I would suggest that you post the template here so that I can help you out with the necessary code to get this done.

Author

Commented:
It's definitely still deleting rows in the original letter even with the DoEvents.  So... the letter is not returning to it's original state.  Is there a refresh command or undo delete?

Author

Commented:
This is the code we have...


Sub DeleteRows2()
'
'  DeleteRows2 Macro
'
  Dim d As Document, t As Table
  Dim TargetText As String
  Dim oRow As Row
  Set d = ActiveDocument

  TargetText = "DELETE" 'InputBox$("Enter target text:", "Delete Rows")
    For Each t In d.Tables
         
            For Each oRow In t.Rows
                If InStr(oRow.Cells(1).Range.Text, TargetText) = 1 Then oRow.Delete
            Next
    Next
End Sub

Sub MergeWithDeleteNEW()

    With ThisDocument.MailMerge
        .DataSource.ActiveRecord = wdFirstRecord
        For Item = 1 To .DataSource.RecordCount
            .DataSource.ActiveRecord = Item
            .Destination = wdSendToEmail
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = .ActiveRecord
                .LastRecord = .ActiveRecord
            End With
            .Execute Pause:=False
            DoEvents
            Call DeleteRows2
            Call SendEmail
        Next Item
    End With
   
    End Sub
   
    Sub SendEmail()

Set outlookApp = CreateObject("Outlook.Application")
Set outlookMail = outlookApp.CreateItem(olMailItem)

With outlookMail
   .To = "name@domain.com"
   .Subject = "email subject"
   .Body = ActiveDocument.Content.Text
   .Send
End With

End Sub

please note that using  

.Destination = wdSendToEmail

Open in new window


indeed the template will be harmed.
update this line of code to

.Destination = [b]wdSendToNewDocument[/b]

Open in new window

whoops,

apperantly you cannot use bold in code fragments, should have been :

.Destination = wdSendToNewDocument

Open in new window

Author

Commented:
what is the code to close the document and open the document again?

Author

Commented:
Okay, it appears that it's working to delete the rows on the new document - - two more questions -

First, how do I change the code on the SendEmail to pull the email address from the new document?

Second, I am getting a runtime error on the line of code that says
 .DataSource.ActiveRecord = Item

Author

Commented:
Still need some help fixing the email but solved my question!!