Sub createProposal()
propFolder = "C:\AA-ProjectsDocs\AA_Proposal Templates\"
commPropFileName = "TetraSoft_CLIENTNAME_CommercialProposal_PROJECTNAME_SA.docx"
clientNam = Sheet1.Cells(3, 3)
projNam = Sheet1.Cells(4, 3)
destFileName = propFolder & "TetraSoft_" & clientNam & "_CommercialProposal_" & projNam & ".docx"
Set FSO = CreateObject("Scripting.FileSystemObject")
Call FSO.CopyFile(propFolder & commPropFileName, destFileName, True)
Set FSO = Nothing
Set wordapp = CreateObject("word.Application")
wordapp.Documents.Open destFileName
'wordapp.Visible = True
'wordapp.Activate
For rw = 3 To Sheet1.UsedRange.Rows.Count
findWord = "<" & Sheet1.Cells(rw, 2) & ">"
replaceWith = Sheet1.Cells(rw, 3)
wordapp.Selection.Find.ClearFormatting
wordapp.Selection.Find.Replacement.ClearFormatting
wordapp.Selection.WholeStory
With wordapp.Selection.Find
.Text = findWord
.Replacement.Text = replaceWith
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2
End With
Next
wordapp.Documents.Save
wordapp.Visible = True
'wordapp.Documents.Close
'wordapp.Quit
'Set wordapp = Nothing
End Sub
propFolder = "C:\AA-ProjectsDocs\AA_Proposal Templates\"
commPropFileName = "TetraSoft_CLIENTNAME_CommercialProposal_PROJECTNAME_SA.docx"
clientNam = Sheet1.Cells(3, 3)
projNam = Sheet1.Cells(4, 3)
destFileName = propFolder & "TetraSoft_" & clientNam & "_CommercialProposal_" & projNam & ".docx"
Set FSO = CreateObject("Scripting.FileSystemObject")
Call FSO.CopyFile(propFolder & commPropFileName, destFileName, True)
Set FSO = Nothing
Set wordapp = CreateObject("word.Application")
wordapp.Documents.Open destFileName
'wordapp.Visible = True
'wordapp.Activate
For rw = 3 To Sheet1.UsedRange.Rows.Count
findWord = "<" & Sheet1.Cells(rw, 2) & ">"
replaceWith = Sheet1.Cells(rw, 3)
wordapp.Selection.Find.ClearFormatting
wordapp.Selection.Find.Replacement.ClearFormatting
wordapp.Selection.WholeStory
With wordapp.Selection.Find
.Text = findWord
.Replacement.Text = replaceWith
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2
End With
Next
wordapp.Documents.Save
wordapp.Visible = True
'wordapp.Documents.Close
'wordapp.Quit
'Set wordapp = Nothing
End Sub