Get data from textbox in Word-UserForm

Question

I have a Word document based on a template for invoices and a database in Excel containing two tables: Company and Person.

I want to put some string into the textbox in the userform in Word which will then be searched in Excel. Excel shall return the values to a MultiColumn-Listbox located in another UserForm (this userform will only show if there is more than 1 result for the searched string).

This is the code I have in Word to run the macro, which actually gets started:

CSearchText = UFCompanySearch.tbSearchCompany.Value 'Textbox -> Search-String

xlWB.Application.Run("SearchCompany")

This only works when SearchCompany is a sub or a function with no further specifications, so

Function SearchCompany(SearchText As String)

doesn't work as I cannot run the Macro as follows:

xlWB.Application.Run("SearchCompany("SomeCompany")") 'NOTE!

NOTE: This will NOT work!!

To fill the Listbox in the UserForm I think there is the possibility to fill it with an Excel table, so this should somehow work out.

THIS is the PROBLEM:

I cannot refer to the Search-TextBox in the Userform which is located in the word Document as neither "Doc!" nor "Doc." works. Like this I can't search the cells for the string. This is the code I have to find cells containing the string:

IF (InStr(xlComp.Cells(Row, 1), CSearchText) > 0) Or _
    (InStr(xlComp.Cells(Row, 2), CSearchText) > 0) Or _
    (InStr(xlComp.Cells(Row, 3), CSearchText) > 0) Then

This searches the Columns A-C for the entered string. (Code I found somewhere... I have been searching too much to know where from ^.^)

Is there a way to address the UserForm in Word or a workaround to get the "SearchText" from the userform to Excel?

I'm quite new in VBA, so the more detailed your answer the more probable I will understand it.

A good article on using Run: rondebruin.nl/win/s9/win001.htm — Tim Williams
xlWB.Application.Run("SearchCompany("SomeCompany")") should be xlWB.Application.Run("SearchCompany","SomeCompany") — Nathan_Sav
Tim & Nathan: Doesn't work either... :( I immediately get a compile error expecting a "=". (xlWB.Application.Run("'" & xlWB & "'!SearchFirma", FSearchText) / xlWB.Application.Run ("SearchFirma", FSearchText)). It really seems on Mac it's just not the same... -.- any other ideas? — Kathara
Application.Run ("'xlWB'!SearchFirma(" & FSearchText & ")") AND Application.Run ("'xlWB'!SearchFirma(FSearchText)") are throwing the Error '4120': Bad Parameter — Kathara

Kathara Kathara · Accepted Answer · 2016-01-19T15:46:42

As I did not find a way to do it directly I got a workaround when trying:

Code in Word:

Private Sub cbFirmaSearch_Click()

    ActiveDocument.FormFields("FSearchText").Result = UFFirmaSearch.txtFirmaSuchen.Value

    xlWB.Application.Run "SearchFirma"

    ActiveDocument.FormFields("FSearchText").Delete

    Dim DFLastRow  As Integer
    DFLastRow = xlWB.Sheets("DataFirma").Cells(xlWB.Sheets("DataFirma").Rows.Count, "a").End(xlUp).Row

    Dim lbFirmTar As ListBox
    Set lbFirmTar = UFFirmaSearchList.lbFirmaSearchList

    Dim Row As Integer
    For Row = 2 To DFLastRow
        With lbFirmTar
            Dim ListIndex As Integer
            ListIndex = UFFirmaSearchList.lbFirmaSearchList.ListCount
            .AddItem xlWB.Sheets("DataFirma").Cells(Row, 1).Value, ListIndex
            .List(ListIndex, 1) = xlWB.Sheets("DataFirma").Cells(Row, 2).Value
            .List(ListIndex, 2) = xlWB.Sheets("DataFirma").Cells(Row, 3).Value
            .List(ListIndex, 3) = xlWB.Sheets("DataFirma").Cells(Row, 4).Value
            .List(ListIndex, 4) = xlWB.Sheets("DataFirma").Cells(Row, 5).Value
            .List(ListIndex, 5) = xlWB.Sheets("DataFirma").Cells(Row, 6).Value
            .List(ListIndex, 6) = xlWB.Sheets("DataFirma").Cells(Row, 7).Value
        End With
    Next Row

    With UFFirmaSearchList
        If (.lbFirmaSearchList.ListCount > 1) Then
            UFFirmaSearch.Hide
            .Show
        ElseIf (.lbFirmaSearchList.ListCount = 1) Then
            FirmaID = .lbFirmaSearchList.List(0, 0)
            FirmaZusatz = .lbFirmaSearchList.List(0, 1)
            FirmaName = .lbFirmaSearchList.List(0, 2)
            FirmaAbteilung = .lbFirmaSearchList.List(0, 3)
            FirmaAdresse = .lbFirmaSearchList.List(0, 4)
            FirmaPLZ = .lbFirmaSearchList.List(0, 5)
            FirmaOrt = .lbFirmaSearchList.List(0, 6)
            UFFirmaSearch.lblfrFirmenangaben = "Firma ID : " & FirmaID & _
                                                "Firmenzusatz : " & FirmaZusatz & _
                                                "Name : " & FirmaName & _
                                                "Firmenabteilung : " & FirmaAbteilung & _
                                                "Adresse : " & FirmaAdresse & _
                                                "PLZ / Ort : " & FirmaPLZ & " " & FirmaOrt
        Else
            MsgBox "No Entry found.", vbOKOnly
        End If
    End With
    UFFirmaSearch.txtFirmaSuchen.SetFocus
End Sub

Code in Excel:

Sub SearchFirma()

    Dim Doc As Word.Document
    Set Doc = ActiveDocument

    Dim xlFirm As Worksheet
    Set xlFirm = ActiveWorkbook.Sheets("Firma")

    Dim LastRow As Integer 'Last row on sheet "Firma" containing values
    LastRow = xlFirm.Cells(xlFirm.Rows.Count, "a").End(xlUp).Row

    Dim xlDatFirm As Worksheet
    Set xlDatFirm = ActiveWorkbook.Sheets("DataFirma")

    Dim FSearchText As String
    FSearchText = Doc.FormFields("FSearchText").Result

    For Row = 2 To LastRow
        Dim DFNewRow As Integer  'Next free line on sheet "DataFirma"
        DFNewRow = xlDatFirm.Cells(xlDatFirm.Rows.Count, "A").End(xlUp).Row + 1
        If (InStr(1, xlFirm.Cells(Row, 1), FSearchText, vbTextCompare) > 0) Or (InStr(1, xlFirm.Cells(Row, 2), FSearchText, vbTextCompare) > 0) Or (InStr(1, xlFirm.Cells(Row, 3).Value, FSearchText, vbTextCompare) > 0) Or (InStr(1, xlFirm.Cells(Row, 4).Value, FSearchText, vbTextCompare) > 0) Then
            xlDatFirm.Range("A" & DFNewRow).Value = xlFirm.Cells(Row, 1).Value
            xlDatFirm.Range("B" & DFNewRow).Value = xlFirm.Cells(Row, 2).Value
            xlDatFirm.Range("C" & DFNewRow).Value = xlFirm.Cells(Row, 3).Value
            xlDatFirm.Range("D" & DFNewRow).Value = xlFirm.Cells(Row, 4).Value
            xlDatFirm.Range("E" & DFNewRow).Value = xlFirm.Cells(Row, 5).Value
            xlDatFirm.Range("F" & DFNewRow).Value = xlFirm.Cells(Row, 6).Value
            xlDatFirm.Range("G" & DFNewRow).Value = xlFirm.Cells(Row, 7).Value
        End If
    Next Row
End Sub

Somehow this works. When I first tried "Dim xlWB As Excel.Workbook" in Word I would always get a runtime error. When I tried "Dim Doc As Word.Document" in Excel though I never got an error... very strange but still somehow managed to get it over with.

If you have any questions regarding this I will be happy to try to help and if there are things that I can rewrite in a better way, please don't hesitate to comment.

Thanks for the support :)

Get data from textbox in Word-UserForm

1 Answers