Help, I can't figure out and Can I do

[nmc]

Hello I want to create a code VBA code that allows the point above but I don't found any resource that speaks directly on this:

1. Open a dialog box to choose a word file in the path: C:\Add-in\Company\Templates in docx format

2. Select as active sheet Checklist the file: "Checklist - One"

3. Populate all the bookmarks of the word file with content cells that have name equal as the bookmarks (use sheet checklist)

4. If the Checklist sheet has a cell named "Gender" and the content is equal to "Female" must go to the excel file in the path: C:\Add-in\Company.xlsx on the sheet1 and search all the words in the column A throught the word file and replace with words in the column B otherwise replace with the words in the column C

4. Open a dialog box to input the path to save the word with the name TEST in word and pdf format

5. Close all the files without savings

6. Quit all aplications
Can someone help? I'm trying to figure out VBA code to do this can even recording the macro isn't appearing everything.

 

[rakesh seebaruth]

try this
Sub PopulateWordFile()

Dim wordFile As String
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim excelFile As String
Dim excelApp As Excel.Application
Dim excelWbk As Excel.Workbook
Dim excelWsh As Excel.Worksheet
Dim savePath As String
Dim saveName As String

' Step 1 - Open dialog box to choose word file
wordFile = Application.GetOpenFilename(FileFilter:="Word Files (*.docx), *.docx", Title:="Choose Word File")
If wordFile = "False" Then
Exit Sub
End If

' Step 2 - Open word file and select Checklist sheet
Set wordApp = New Word.Application
Set wordDoc = wordApp.Documents.Open(wordFile)
wordDoc.Activate

' Step 3 - Populate bookmarks with cells from Checklist sheet
For Each bkmk In wordDoc.Bookmarks
bkmk.Range.Text = ThisWorkbook.Sheets("Checklist").Range(bkmk.Name).Value
Next bkmk

' Step 4 - Check if gender is female, replace words with column B
If ThisWorkbook.Sheets("Checklist").Range("Gender").Value = "Female" Then
excelFile = "C:\Add-in\Company.xlsx"
Set excelApp = New Excel.Application
Set excelWbk = excelApp.Workbooks.Open(excelFile)
Set excelWsh = excelWbk.Sheets("Sheet1")

For Each wd In wordDoc.Words
For i = 1 To excelWsh.Range("A" & Rows.Count).End(xlUp).Row
If wd = excelWsh.Range("A" & i).Value Then
wd.Text = excelWsh.Range("B" & i).Value
Exit For
End If
Next i
Next wd

excelWbk.Close False
excelApp.Quit
Else
' Replace words with column C
excelFile = "C:\Add-in\Company.xlsx"
Set excelApp = New Excel.Application
Set excelWbk = excelApp.Workbooks.Open(excelFile)
Set excelWsh = excelWbk.Sheets("Sheet1")

For Each wd In wordDoc.Words
For i = 1 To excelWsh.Range("A" & Rows.Count).End(xlUp).Row
If wd = excelWsh.Range("A" & i).Value Then
wd.Text = excelWsh.Range("C" & i).Value
Exit For
End If
Next i
Next wd

excelWbk.Close False
excelApp.Quit
End If

' Step 5 - Open dialog box to input save path and name
savePath = Application.GetSaveAsFilename(InitialFileName:="TEST", FileFilter:="Word Files (*.docx), *.docx, PDF Files (*.pdf), *.pdf", Title:="Save File As")

If savePath = "False" Then
Exit Sub
Else
saveName = Split(savePath, ".")(0)

wordDoc.SaveAs saveName & ".docx"
wordDoc.SaveAs saveName & ".pdf", 17

' Step 6 - Close all files without saving
wordDoc.Close False
wordApp.Quit

End Sub

 

[nmc]

Is giving me an error Block if without ending if