How to Delete Rows from a table created in WORDS thats blank 2

[WOP29]

In order to understand my questions let me give you some background detail that should help.

I've created a Mail Merge in Microsoft Word and converted it to Edit Individual Documents(this puts all records on one file separated by page break).

Below is a sample of what I'm using:

Dear James,

(TABLE BELOW)
Items Description Quantity
«Item_1» «Quantity_»
«Item_2» «Quantity_2»
«Item_3» «Quantity_3»
«Item_4» «Quantity_4»

----page break----

Dear Bob,

(TABLE BELOW)
Items Description Quantity
«Item_1» «Quantity_»
«Item_2» «Quantity_2»

----page break----

Dear Bob,

(TABLE BELOW)
Items Description Quantity
«Item_1» «Quantity_»
«Item_2» «Quantity_2»
«Item_3» «Quantity_3»
----page break----

What I am trying to show is that each table within the template email will not be the same. One template email might have 5 rows while the other might have 2 rows. The columns does not change. I was able to create a VB code that eliminate the rows that labeled "Remove", but my problem is that I have to run the macro one at a time for each table and also I have to change the VB code to reflect the table. For instance .Table(1), .Table(2), etc in the VB code(listed below).

Request:
Is there a way to have the VB code Loop through the file and remove the rows from all the table with the word "Remove" so i don't have to manually run the macro per table.

If possible instead of the word "remove", ideally I would prefer that the VB code remove any row that is blank from all table at once.

VB CODE that i use to remove the row manually:

Sub deletion()
With ThisDocument.Tables(1)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "REMOVE") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
Next
End With

End Sub

 

[Andrzejek]

I would be very tempted to do:

Sub deletion()[blue]
Dim intT As Integer

For intT = 1 to ThisDocument.Tables.Count[/blue]
With ThisDocument.Tables([blue]intT[/blue])
For r = .Rows.Count To 1 Step -1
        fnd = False
        For Each c In .Rows(r).Cells
            If InStr(c.Range.Text, "REMOVE") > 0 Then fnd = True
        Next
        If fnd Then .Rows(r).Delete
    Next
End With
[blue]Next intT[/blue]
End Sub

Have fun.

---- Andy

 

[TonyJollans]

Nothing to do with the Merge, really, this just deletes empty rows. It could probably be optimised for your specific situation if you wanted.

[blue]Sub DeleteRows()
Dim T As Word.Table
Dim R As Word.Row
Dim x As Long
For Each T In ActiveDocument.Content.Tables
    For x = T.Rows.Count To 1 Step -1
        Set R = T.Rows(x)
        If EmptyRow(R) Then R.Delete
    Next
Next T
End Sub
Function EmptyRow(R As Word.Row) As Boolean
Dim C As Word.Cell
EmptyRow = True
For Each C In R.Cells
    If C.Range.Characters.Count > 1 Then
        EmptyRow = False
        Exit Function
    End If
Next
End Function[/blue]

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[WOP29]

Thank TonyJollans and Andrzejek for you response. As I was waiting on a response I manage to find another VB code that works. I provided below in case others are interested:

Sub DelBlankRows()
Dim tblT As Table
Dim cllC As Cell
Dim blnEmpty As Boolean
Dim n As Integer

On Error GoTo ErrHnd

'loop through all tables in the document
For Each tblT In ActiveDocument.Tables()
'loop through each row in table, starting at the end
'of the table - so delete doesn't change row numbers
For n = tblT.Rows.Count To 1 Step -1
'set flag for empty row
blnEmpty = True
'go through each cell in row
For Each cllC In tblT.Rows.Cells()
'test if cell contains more than table marker
If cllC.Range.Characters.Count > 1 Then
'if any cell has more than table marker
'the cell and therefore the row is not empty
blnEmpty = False
End If
Next cllC
'if all cells in row empty - delete row
If blnEmpty = True Then
tblT.Rows.Delete
End If
Next n
Next tblT
Exit Sub
'error handler
ErrHnd:
Err.Clear
End Sub

 

[WOP29]

Another issue that I hope someone can help. The whole purpose is to send out a Mail Merge in HTML format while customizing the Subject Line, CC and adding attachments. So once I converted the file to "Edit Individual Document", I then used the above VB code to removed all row and then I use the following code that reference to a WORD document directory to automatically send out the Mail Merge:

Dim Counter As Integer, i As Integer
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim mysubject As Range

Set Source = ActiveDocument

' Check if Outlook is running. If it is not, start Outlook

On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If

' Open the catalog mailmerge document

With Dialogs(wdDialogFileOpen)
.Show
End With
Set Maillist = ActiveDocument

' Iterate through the rows of the catalog mailmerge document, extracting the information
' to be included in each email.
Counter = 1
While Counter <= Maillist.Tables(1).Rows.Count
Source.Sections.First.Range.Cut
Documents.Add
Selection.Paste
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
Set mysubject = Maillist.Tables(1).Cell(Counter, 2).Range
mysubject.End = mysubject.End - 1
.Subject = mysubject
.Body = ActiveDocument.Content
Set Datarange = Maillist.Tables(1).Cell(Counter, 1).Range
Datarange.End = Datarange.End - 1
.To = Datarange
For i = 3 To Maillist.Tables(1).Columns.Count
Set Datarange = Maillist.Tables(1).Cell(Counter, i).Range
Datarange.End = Datarange.End - 1
.Attachments.Add Trim(Datarange.Text), olByValue, 1
Next i
.Importance = olImportanceHigh
.ReadReceiptRequested = True
.Send
End With
Set oItem = Nothing
ActiveDocument.Close wdDoNotSaveChanges
Counter = Counter + 1
Wend

' Close Outlook if it was started by this macro.

If bStarted Then
oOutlookApp.Quit
End If

'Clean up

Set oOutlookApp = Nothing
Source.Close wdDoNotSaveChanges
Maillist.Close wdDoNotSaveChanges

End Sub

The problem[\b] with this is that it sends the files as TEXT and not HTML format. I also converted the file to HTML (so once the file was converted to "Edit Individual File" and the rows removed, i saved the file as Web Page). I took the code and pasted it to Words and then just sent it out from there but it send it everything to the first recipient and nothing is sent to the other recipient.

 

[TonyJollans]

If you want to e-mail, why don't you merge direct to e-mail?

I have only skimmed your code (and am not really an Outlook person) but the .Body of a MailItem is just text, and I think you need to use .HTMLBody for HTML.

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[WOP29]

Thanks for you assistance but merging direct to e-mail will not allow for the custom subject line per recipient and custom attachments.

When the .Body is changed to .HTMLBody nothing happens. If the whole document is not converted to HTML the file will still be sent as text.