I am trying to automate an engagement letter using the cell values from multiple columns and rows. When I used the for loop, I ran with type mismatch which I do not know how to debug. Below are my vba codes:
Code:
Option Explicit
Public Sub WordFindAndReplaceSave()
Dim ws As Worksheet, msWord As Object
Dim currentRow As Long
Dim rowCount As Long
Dim lastRow As Long
Dim filename As String
Dim Path1 As String
Path1 = "C:\Users\xlim\Desktop\Edited Letters"
Set ws = ActiveSheet
Set msWord = CreateObject("Word.Application")
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row
For currentRow = 2 To lastRow
filename = ws.Cells("A", "currentRow + 1").Value
With msWord
.Visible = True
.Documents.Open "C:\Users\xlim\Desktop\LOR - STC.docx"
.Activate
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "KOOLOOK PTE. LTD."
.Replacement.Text = ws.Cells("A", "currentRow + 1")
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "31 October 2017"
.Replacement.Text = ws.Cells("B", "currentRow + 1")
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "30 April 2018"
.Replacement.Text = ws.Cells("C", "currentRow + 1")
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Delvyn Wong Wern Liat"
.Replacement.Text = ws.Cells("D", "currentRow + 1")
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Director"
.Replacement.Text = ws.Cells("E", "currentRow + 1")
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
msWord.ActiveDocument.SaveAs filename:=Path1 & "/" & "LOR - " & filename & ".docx"
rowCount = rowCount + 1
End With
Next currentRow
End Sub
Last edited by a moderator: