Excel VBA - Open Word template and create bulleted list based on cell values

[reefaman]

Hello,
I have a sheet(Sheet2) with a list in column A starting in cell A7 going to A100. From Excel I would like to be able to open a Word template and create a selective bulleted list based on a “Y” being in the corresponding cell in column B. I would also like to make the item in the list bold if there is a “Y” in the corresponding cell in column C. I have the following code, copied from various forums, which opens the template and saves it with a timestamp but does not create the list. Can anyone help?
If it is not possible to create a bulleted list or make selected items bold, can I just produce the selective list?
I am using Office 2007 on Windows 7.
Thanks,

Option Explicit 
 
 
Sub NewList() 
     
     
    Dim pappWord As Object 
    Dim docWord As Object 
    Dim wb As Excel.Workbook 
    Dim xlName As Excel.Name 
    Dim TodayDate As String 
    Dim Path As String 
    Dim sNewFileName As String 
    Dim sSaveAs As String 
    Dim sSaveIn As String 
    Dim rangetocopy As Range 
     
     
    Set rangetocopy = Range("A7").CurrentRegion 
    Set wb = ActiveWorkbook 
    TodayDate = Format(Date, "mmmm d, yyyy") 
    Path = wb.Path & "\NewList.dot" 
    sNewFileName = Range("G1").Value 
    sSaveIn = Range("G3").Value 
    sSaveAs = sSaveIn & "/" & sNewFileName & " " & Format(Date, "DD-MMM") & " " & ".doc" 
     
     
    On Error Goto ErrorHandler 
     
     
     'Create a new Word Session
    Set pappWord = CreateObject("Word.Application") 
     
     
    On Error Goto ErrorHandler 
     
     
     'Open document in word
    Set docWord = pappWord.Documents.Add(Path) 
    pappWord.ActiveDocument.SaveAs sSaveAs 
     
     
     'Activate word and display document
    With pappWord 
        .Visible = True 
        .ActiveWindow.WindowState = 1 
        .Activate 
         
         
         'Paste the copied contents
        Selection.GoTo What:=wdGoToLine, Which:=wdGoToRelative, Count:=4 
        rangetocopy.Copy 
        docWord.Words(1).PasteExcelTable False, False, False 
    End With 
     
     
     'Release the Word object to save memory and exit macro
ErrorExit: 
    Set pappWord = Nothing 
    Exit Sub 
     
     
     'Error Handling routine
ErrorHandler: 
    If Err Then 
        MsgBox "Error No: " & Err.Number & "; There is a problem" 
        If Not pappWord Is Nothing Then 
            pappWord.Quit False 
        End If 
        Resume ErrorExit 
    End If 
End Sub