Microsoft Office Forums - View Single Post - Need help with VBA macro to copy text from Word to Excel according to a list

syl3786 · 07-27-2023, 05:03 AM

Quote:

Originally Posted by Journeyman

Hi.

I'm sorry this didn't work for you first time. This strikes me as an odd error, however, I have tested this from a different PC and it works as intended.

I've added two files as an attachment to this message.
- a basic word doc with a table - save to a temp folder
- an excel SS with a button included on the sheet.

the button is the only real addition.

Click the button and point the dialog to the word doc.

Note that the word table only contains a couple rows, but you can add more - and more info into the second column also.

Try again - hope it works this time.

Cheers

Thanks for your help. I apologize for the inconvenience caused since I think you may misunderstand what I aim to do. I hope to write a macro like the following:

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

However, this VBA limited to copy text like "Speaker 1", "Speaker 2", "Speaker 3" etc. I want to edit it as a macro that can copy the text from a Word Document according to an Excel sheet and then paste on designated Excel sheet.