1
votes

I need VBA Code to get header bookmark in the Excel UserForm1 Textbox. Please assist me. I have got the page count, but not able to get this. I have placed the Code below, which I've tried, but it is not working.

I get error at:

Set wbk = ObjExcel.Workbooks.Open("C:\Users\Desktop\Test-2.xlsm")

and

wst.txtstatementof.Text = "MyBookmark"

Thanks in advance.

Sub ExportBookmarksToExcel() Dim bk As Bookmark Dim appXl As Excel.Application Dim wbk As Excel.Workbook Dim wst As Excel.Worksheet Dim x As UserForm1

Set appXl = CreateObject("Excel.Application")
Set wbk = ObjExcel.Workbooks.Open("C:\Users\Desktop\Test-2.xlsm")
With appXl
    .Visible = True
    Set wbk = .Workbooks.Add
    Set wst = wbk.UserForm1
     wst.txtstatementof.Text = "MyBookmark"
  End With

'For each bk In ActiveDocument.Bookmarks
    'lRow = lRow + 1
 '   wst.x.UserForm1.txtstatementof.Text = bk.Name
    'wst.Cells(lRow, 2) = bk.Range.Text
'Next bk
'wst.UsedRange.Columns.AutoFit

 End Sub
1

1 Answers

0
votes

Actually, you weren't far from success. Of course, this must fail:-

Set appXl = CreateObject("Excel.Application")
Set wbk = ObjExcel.Workbooks.Open("C:\Users\Desktop\Test-2.xlsm")

You can see that your Excel application is called appXl. Therefore it can't respond to ObjExcel.Workbooks.Open.

Below is the code that works.

Sub ExportBookmarksToExcel()

    ' MS Word variables:
    Dim Bk As Bookmark
    Dim R As Long

    ' MS Excel variables:
    Dim appXl As Excel.Application
    Dim Wbk As Excel.Workbook
    Dim Wst As Excel.Worksheet

    Set appXl = CreateObject("Excel.Application")
    With appXl
        .Visible = True
'        Set Wbk = .Workbooks.Open("C:\Users\Desktop\Test-2.xlsm")
        Set Wbk = .Workbooks.Add
        Set Wst = Wbk.Worksheets(1)
'        Wst.txtstatementof.Text = "MyBookmark"     ' what is "txtstatementof" ?
    End With

    R = 2                                           ' keep Row 1 for captions
    For Each Bk In ActiveDocument.Bookmarks
        Wst.Cells(R, 1) = Bk.Name
        Wst.Cells(R, 2) = Bk.Range.Text
        R = R + 1
    Next Bk
    Wst.UsedRange.Columns.AutoFit

 End Sub