Bookmarks in a word document

[Joshyd]

Hi There!

I have two columns of data, one that has a list of bookmarks and another with corresponding data in a workbook. I need to write a macro that looks at the data column, assesses to see if it blank. If it is not blank, it needs to look at the bookmark name and put the data into the word doc.

I have done this on a way more basic level, just telling VBA exactly what the bookmark is named and what range the value should be replaced with, for example:

Sub Example() Dim ws As Worksheet
 Set ws = Sheets("Sheet1")
 Dim objword As Object 
 Dim objDoc As Object
 Set objword = CreateObject("Word.Application")
 objword.Visible = True 


MsgBox "Generating Word Document", vbExclamation, "Word"
Application.ScreenUpdating = False
 
  Set objDoc = objword.Documents.Add("example\path")
  
  With objDoc
   .Bookmarks("Example").Range.Text = ws.Range("B3").Value
    .Bookmarks("Example2").Range.Text = ws.Range("B4").Value
    .Bookmarks("Example3").Range.Text = ws.Range("B7").Value

I am hoping this could be looped and have the modifier for looking for blanks. I tried doing this, but with little success (I am still a serious noob). I appreciate any help or starting points.

Thanks,
Josh

 

[Akuini]

Try this:
Put the bookmark names in col A & the words to insert in col B.

[FONT=Lucida Console][COLOR=Royalblue]Dim[/COLOR] ws [COLOR=Royalblue]As[/COLOR] Worksheet
 [COLOR=Royalblue]Set[/COLOR] ws = Sheets([COLOR=Darkcyan]"Sheet1"[/COLOR])
 [COLOR=Royalblue]Dim[/COLOR] objword [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]
 [COLOR=Royalblue]Dim[/COLOR] objDoc [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]
 [COLOR=Royalblue]Dim[/COLOR] c [COLOR=Royalblue]As[/COLOR] Range
 
 [COLOR=Royalblue]Set[/COLOR] objword = CreateObject([COLOR=Darkcyan]"Word.Application"[/COLOR])
 objword.Visible = True


MsgBox [COLOR=Darkcyan]"Generating Word Document"[/COLOR], vbExclamation, [COLOR=Darkcyan]"Word"[/COLOR]
Application.ScreenUpdating = False
 

[COLOR=Royalblue]Set[/COLOR] objDoc = objword.Documents.Add([COLOR=Darkcyan]"example\path"[/COLOR])
  
  [COLOR=Royalblue]With[/COLOR] ws
  [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] c In .Range([COLOR=Darkcyan]"A1"[/COLOR], .Cells(.Rows.count, [COLOR=Darkcyan]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
        [COLOR=Royalblue]If[/COLOR] c <> [COLOR=Darkcyan]""[/COLOR] [COLOR=Royalblue]Then[/COLOR]
            [COLOR=Royalblue]On[/COLOR] [COLOR=Royalblue]Error[/COLOR] [COLOR=Royalblue]Resume[/COLOR] [COLOR=Royalblue]Next[/COLOR]
            objDoc.Bookmarks(c).Range.[COLOR=Royalblue]Text[/COLOR] = c.Offset(, [COLOR=Brown]1[/COLOR])
            [COLOR=Royalblue]If[/COLOR] err.Number = [COLOR=Brown]5941[/COLOR] [COLOR=Royalblue]Then[/COLOR] Debug.Print [COLOR=Darkcyan]"[COLOR=Royalblue]Not[/COLOR] found :"[/COLOR] & c
            [COLOR=Royalblue]On[/COLOR] [COLOR=Royalblue]Error[/COLOR] [COLOR=Royalblue]GoTo[/COLOR] [COLOR=Brown]0[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
  [COLOR=Royalblue]Next[/COLOR]
  [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR][/FONT]

But I'm not sure about this part:
Set objDoc = objword.Documents.Add("example\path")
You don't specify the full file path+name, does it work for you?

 

[Joshyd]

Hi @Akuini!

Thanks for the help, this did work perfectly for me with a little tweaking. I left the path like that because it is always changing.

Here is the code I ended up using for anyone who is curious.

Sub Document()


Dim ws As Worksheet
Set ws = Sheets("Schedule Builder")
Dim objword As Object
Dim objDoc As Object
Dim c As Range


Set objword = CreateObject("Word.Application")
Set Path = Range("Y11")
objword.Visible = True




MsgBox "Generating Word Document", vbExclamation, "Word"
Application.ScreenUpdating = False


Set objDoc = objword.Documents.Add(Path.Text)
    
    With ws
    For Each c In .Range("L3", .Cells(.Rows.Count, "L").End(xlUp))
    If c.Text <> "" Then
            On Error Resume Next
            objDoc.Bookmarks(c.Offset(0, -1).Text).Range.Text = c.Text
            If Err.Number = 5941 Then Debug.Print "Not found :" & c
            On Error GoTo 0
        End If
  Next
  End With


End Sub

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.