好的，因为没有人知道如何做到这一点，这是一种方法，以防万一其他人正在寻找类似的解决方案...希望它有帮助...

OK, as nobody here knows how to do this, here is a way of doing it in case anybody else is looking for a similar solution ... hope it helps ...

'Create a link to use Excel

    If Tasks.Exists(Name:="Microsoft Excel") = False Then
        Set xlApp = CreateObject("Excel.Application")
    ElseIf Tasks.Exists(Name:="Microsoft Excel") = True Then
        Set xlApp = GetObject(, "Excel.Application")
    End If

'Ensure Excel is Visible & not Hidden
    
    xlApp.Application.Visible = True

'Open the Excel File that you want to edit
    xlApp.Workbooks.Open myFolderPath + "Manager Of The Month.xlsx"
    
'Define specific Cells in the Excel file & Select the first one

    Dim myCell1 as String
    Dim myCell2 as String
    Dim myCell3 as String

    myCell1 = "B" & mySession + 1
    myCell2 = "C" & mySession + 1
    myCell3 = "D" & mySession + 1
    
    xlApp.Range(myCell1).Select
    
'Wait until the Cells you want filled in the Excel file have all been filled

    Do
        'nothing
    Loop Until xlApp.Range(myCell1) > "" And xlApp.Range(myCell2) > "" And xlApp.Range(myCell3) > ""
    
'Replace the text "MOTMDIV1" with the data entered into the first Excel Cell

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "MOTMDIV1"
        .Replacement.Text = xlApp.Range(myCell1).Value
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

'Complete the edit update in the Word document by actually making the change

    Selection.Find.Execute Replace:=wdReplaceAll

'Replace the text "MOTMDIV2" with the data entered into the second Excel Cell

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "MOTMDIV2"
        .Replacement.Text = xlApp.Range(myCell2).Value
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

'Complete the edit update in the Word document by actually making the change

    Selection.Find.Execute Replace:=wdReplaceAll

'Replace the text "MOTMDIV3" with the data entered into the third Excel Cell

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "MOTMDIV3"
        .Replacement.Text = xlApp.Range(myCell3).Value
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

'Complete the edit update in the Word document by actually making the change

    Selection.Find.Execute Replace:=wdReplaceAll

'Save & Quit Excel

    xlApp.ActiveWorkbook.Save
    xlApp.Quit
    
    Set xlApp = Nothing

这可以通过多种方式改进，包括如果你有很多Cell，使用一个循环，但它对我有用，因为它是个人程序，我很满意。

This can probably be improved upon in many ways, including using a loop if you have a lot of Cells, but it''s working for me and as it is a personal program I am happy with it.