Thank you gmayor for help.
The following code removes table located in a bookmark named "Bookmark1".
Option Explicit
Sub ClearBookmarks()
Application.ScreenUpdating = False
Dim strFolder As String
Dim strFile As String
Dim wdDoc As Document
Dim oRng As Range
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
wdDoc.Activate
With wdDoc
Set oRng = ActiveDocument.Tables(1).Range
FillBM_with_Table "Bookmark1", oRng
Set oRng = Nothing
End With
wdDoc.Close SaveChanges:=True
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = False
End Sub
Private Sub FillBM_with_Table(strBMName As String, oSource As Range)
'Graham Mayor
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
If oRng.Tables.Count > 0 Then oRng.Tables(1).Delete
oRng.FormattedText = oSource.FormattedText
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
I have tried to modify the code so that it loops through every bookmark in the document and deletes tables in bookmarks. However so far my attempts have been fruitless. e.g.
Option Explicit
Sub ClearBookmarks()
Application.ScreenUpdating = False
Dim strFolder As String
Dim strFile As String
Dim strName As String
Dim wdDoc As Document
Dim i As Long
Dim oRng As Range
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
wdDoc.Activate
With wdDoc
Set oRng = ActiveDocument.Tables(1).Range
For i = 1 To ActiveDocument.Bookmarks.Count
strName = ActiveDocument.Bookmarks(i).Name
FillBM_with_Table strName, oRng
Next i
Set oRng = Nothing
End With
wdDoc.Close SaveChanges:=True
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = False
End Sub
Private Sub FillBM_with_Table(strBMName As String, oSource As Range)
'Graham Mayor
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
If oRng.Tables.Count > 0 Then oRng.Tables(1).Delete
oRng.FormattedText = oSource.FormattedText
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
Any help or advice would be greatly appreciated.