使用VBA在Word文档中填充Excel数据

Question

I have a word document and I would like to populate same words coming from excel. Lets say both are located in c:\\test I have some knowledge to using vba but this one is a bit over it. In my word document I have a sentence lets say: I am firstname lastname and my username is username and this is my department: department

I have an excel called data, with a sheet called sheet1 with a table called users and some column: username, firstname, lastname, department. The table is an odbc connected table and it refreshes when the workbook opens.

1. My first question is what kind of object should I use for firstname, lastname, username, deparment in word? I inserted a Rich text control content and inside that a legacy form/textform field and renamed the bookmarks to firstname, lastname.. etc.
2. I would like to populate the data in word from excel using macro and vlookup. I don't really have idea how this can be done, I have a bit of code, but it does not work. When the macro started a window should pop up asking the username and based on that value the other boxes will be filled in.

Code Below:

Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
Dim username As String
Dim firstname As String
Dim lastname As String
Dim department As String

username = InputBox("Please enter the username", "Input")

Set exWb = objExcel.Workbooks.Open("C:\test\data.xlsx")

username = objExcel.WorksheetFunction.VLookup(username, _
 eexWb.ActiveSheet.Range("A:F"), 1, False)

firstname = objExcel.WorksheetFunction.VLookup(username, _
 eexWb.ActiveSheet.Range("A:F"), 2, False)

lastname = objExcel.WorksheetFunction.VLookup(username, _
 eexWb.ActiveSheet.Range("A:F"), 3, False)

department = objExcel.WorksheetFunction.VLookup(username, _
 eexWb.ActiveSheet.Range("A:F"), 4, False)

exWb.Close

Set exWb = Nothing

Answer 1

The below code should accomplish what you need. Take the following notes:

1. I used early binding (to take advantage of intellisense). In the Word VBE, in Tools > References, check Microsoft Excel XX.X Object Library
2. You can create a simple bookmark with no need to insert objects. You may still wish to do that, but you may need to adjust the UpdateBookmark procedure to get it to work properly.

Code:

Sub LoadInfo()

    Dim objExcel As Excel.Application 'note early binding (set in Tools > References > Microsoft Excel XX.X library
    Set objExcel = New Excel.Application

    Dim username As String
    Dim firstname As String
    Dim lastname As String
    Dim department As String

    username = InputBox("Please enter the username", "Input")

    Dim exWB as Excel.Workbook        
    Set exWB = objExcel.Workbooks.Open("C:\test\data.xlsx")

    With exWB.Worksheets("Sheet1")

        Dim rngUN As Excel.Range
        Set rngUN = .Columns("A").Find(what:=username, lookat:=xlWhole)

        If Not rngUN Is Nothing Then

            firstname = rngUN.Offset(, 2)
            lastname = rngUN.Offset(, 3)
            department = rngUN.Offset(, 4)

        Else

            MsgBox "Username Not Found. Exiting Sub"
            GoTo ExitSub

        End If

    End With

    UpdateBookmark "username", username, ActiveDocument, False
    UpdateBookmark "firstname", firstname, ActiveDocument, False
    UpdateBookmark "lastname", lastname, ActiveDocument, False
    UpdateBookmark "department", department, ActiveDocument, False

ExitSub:
        exWB.Close
        objExcel.Quit


    End Sub

Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String, wDoc As Word.Document, Optional bReplace As Boolean)
'updates a bookmark range in Word without removing the bookmark name

    Dim BMRange As Word.Range
    Dim sTest As String

    With wDoc

        Set BMRange = .Bookmarks(BookmarkToUpdate).Range

        'if text already exists, add new to old with a carriange return in between
        sTest = BMRange.Text

        If sTest = "" Or bReplace Then

            BMRange.Text = TextToUse

        Else

            BMRange.Text = sTest & vbCr & TextToUse

        End If

        .Bookmarks.Add BookmarkToUpdate, BMRange

    End With

End Sub