Export excel to word using VBA w/bookmarks

Hello,

I have script that was given to me which exports nicely from excel to word. However, I have moved the script to another workbook, and I am having troubles getting it to work. It seems to be getting stuck on the merge look up table. And I really need someone to help me to set the correct range.

You really have to forgive me but I am not a VBA person (formula's no probs) but VBA I'm a real novice.

I've attached the excel and below is the script and the errors that I get.

Option Explicit

Private Const STR_CLIENT_SUMMARY_SHEET_NAME As String = "Summary"
Private Const STR_VARIABLES_SHEET_NAME As String = "Extract_tables"
Private Const STR_Agree_bmarks As String = "Agree_bmarks"

Sub exportTPS_Report()
runMerge STR_Agree_bmarks
End Sub


Public Function runMerge(ByVal strRangeRef As String)
Dim oWordApp As Object
Dim wsRef As Worksheet
Dim mergeLookupTable As Variant
Dim strTemplatePath As String

'On Error GoTo ErrorHandler

mergeLookupTable = ThisWorkbook.Worksheets(STR_VARIABLES_SHEET_NAME).Range(strRangeRef)

Set wsRef = ThisWorkbook.Worksheets(STR_CLIENT_SUMMARY_SHEET_NAME)

strTemplatePath = getFileDirectoryName(msoFileDialogFilePicker, "Please select the MS Word template")

'Create a new Word Session
Set oWordApp = CreateObject("Word.Application")
oWordApp.Visible = True

' merge Excel data w Word
mergeWordDoc oWordApp, wsRef, mergeLookupTable, strTemplatePath


'Release the Word object to save memory and exit macro
ErrorExit:
Set oWordApp = Nothing
Exit Function

'Error Handling routine
ErrorHandler:
If Err Then
MsgBox "Error No: " & Err.Number & "; " & Err.Description
If Not oWordApp Is Nothing Then
oWordApp.Quit False
End If
Resume ErrorExit
End If
End Function

Private Function mergeWordDoc(ByRef oWordApp As Object, ByRef wsSrc As Worksheet, ByRef mergeLookupTable As Variant, ByVal strTemplatePath As String)
Dim docWord As Object
Dim wb As Excel.Workbook
Dim i As Integer
Dim strBookmarkName As String
Dim strTempCellVal As String

'On Error GoTo ErrorHandler

'Open document in word
Set docWord = oWordApp.Documents.Add(strTemplatePath)

'Loop through names in the activeworkbook
With docWord
strTempCellVal = "<error w Excel Named Range>"
For i = LBound(mergeLookupTable) To UBound(mergeLookupTable)
If Trim(mergeLookupTable(i, 1)) <> vbNullString And _
Trim(mergeLookupTable(i, 2)) <> vbNullString Then
strTempCellVal = Trim(wsSrc.Range(mergeLookupTable(i, 2)))
strTempCellVal = Replace(strTempCellVal, vbLf, vbCrLf) ' convert linefeeds into carriage returns/linefeeds

strBookmarkName = mergeLookupTable(i, 1)

I actually fixed it, my mergelookuptable range needed to be fixed. All good now.

Hi Loren,

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between

Please Login or Register  to view this content.

tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here