noslenwerd
12-06-2019, 03:05 PM
I am using VBA code (below) in excel to erase content on my Word Document.
The issue I am running into is, this content has 'Header 1' styling. I would like to delete ALL of the content nested under that 'Header 1'
The red code below does erase the heading with text of "DSSHEADING" , but it does not erase the content nested under it. Any ideas?
Sub CreateWordDocuments()Dim CustRow, CustCol, LastRow As Long
Dim DocLoc, TagName, TagValue, TemplName, FileName As String
Dim WordDoc, WordApp As Object
Dim WordContent As Word.Range
With Sheet1
TemplName = "dssecom.docx" 'Set Template Name
DocLoc = Sheet2.Range("F6").Value 'Word Document Filename
'Open Word Template
On Error Resume Next 'If Word is already running
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
'On Error GoTo Error_Handler
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If
LastRow = .Range("E9999").End(xlUp).Row 'Determine Last Row in Table xlup determines that, this determines how many entries are in the sheet
For CustRow = 8 To LastRow
Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template
For CustCol = 5 To 105 'Move Through 100 Columns
TagName = .Cells(7, CustCol).Value 'Tag Name
TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
With WordDoc.Content.Find
.Text = TagName
.Replacement.Text = TagValue
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll 'Find & Replace all instances
End With
Next CustCol
With WordDoc.Content.Find
.Text = "DSSHEADING"
.Replacement.Text = ""
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll 'Find & Replace all instances
End With
FileName = ThisWorkbook.Path & "\" & .Range("J" & CustRow).Value & "_" & "eCommerce Assessment" & ".docx"
WordDoc.SaveAs FileName 'This is where the new template is created
Next CustRow
End With
End Sub
This has not been cross posted anywhere else. Thank you for your help.
The issue I am running into is, this content has 'Header 1' styling. I would like to delete ALL of the content nested under that 'Header 1'
The red code below does erase the heading with text of "DSSHEADING" , but it does not erase the content nested under it. Any ideas?
Sub CreateWordDocuments()Dim CustRow, CustCol, LastRow As Long
Dim DocLoc, TagName, TagValue, TemplName, FileName As String
Dim WordDoc, WordApp As Object
Dim WordContent As Word.Range
With Sheet1
TemplName = "dssecom.docx" 'Set Template Name
DocLoc = Sheet2.Range("F6").Value 'Word Document Filename
'Open Word Template
On Error Resume Next 'If Word is already running
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
'On Error GoTo Error_Handler
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If
LastRow = .Range("E9999").End(xlUp).Row 'Determine Last Row in Table xlup determines that, this determines how many entries are in the sheet
For CustRow = 8 To LastRow
Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template
For CustCol = 5 To 105 'Move Through 100 Columns
TagName = .Cells(7, CustCol).Value 'Tag Name
TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
With WordDoc.Content.Find
.Text = TagName
.Replacement.Text = TagValue
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll 'Find & Replace all instances
End With
Next CustCol
With WordDoc.Content.Find
.Text = "DSSHEADING"
.Replacement.Text = ""
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll 'Find & Replace all instances
End With
FileName = ThisWorkbook.Path & "\" & .Range("J" & CustRow).Value & "_" & "eCommerce Assessment" & ".docx"
WordDoc.SaveAs FileName 'This is where the new template is created
Next CustRow
End With
End Sub
This has not been cross posted anywhere else. Thank you for your help.