View Single Post
 
Old 04-08-2023, 06:27 AM
syl3786 syl3786 is offline Windows 10 Office 2019
Advanced Beginner
 
Join Date: Jan 2023
Posts: 97
syl3786 is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
This would be essentially the same as your other queries except in reverse.
Start with your document open and save an empty workbook. Then the following macro will find any text that is bold TNR and starts with 'Speaker' and writes them to the empty worksheet column A

Code:
Option Explicit

Private Const xlWB As String = "C:\Path\Empty Excel File name.xlsx"
Private Const xlSheet As String = "Sheet1"

Sub ExtractText()
Dim oDoc As Document
Dim oRng As Range
    Set oDoc = ActiveDocument
    Set oRng = oDoc.Range
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Font.Name = "Times New Roman"
        .Font.Bold = True
        Do While .Execute()
            If oRng.Text Like "Speaker*" Then
                WriteToWorksheet xlWB, xlSheet, oRng.Text
            End If
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub

Private Function WriteToWorksheet(strWorkbook As String, _
                                  strRange As String, _
                                  strValues As String)
Dim ConnectionString As String
Dim strSQL As String
Dim CN As Object
    ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                       "Data Source=" & strWorkbook & ";" & _
                       "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
    strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
    Set CN = CreateObject("ADODB.Connection")
    Call CN.Open(ConnectionString)
    Call CN.Execute(strSQL, , 1 Or 128)
    CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function
Thank you gmayor. I tried but the macro doesn't copy text to the empty Excel sheet1. I ticked the "Microsoft Excel 16.0 object library". Is there any other things I need to preprare for the macro? Thanks again for your help!
Reply With Quote