无法从Access VBA中选择正确的活动文档（单词）

Question

感谢阅读。我在访问中编写了一些VBA，将数据导出到1个Excel工作表和2个Word文档。如果在运行代码时没有其他word文档打开，则一切正常。但是，如果另一个word实例正在运行，我的某些选择和数据将最终出现在“另一个”打开的word文档中。我的问题是我似乎无法从代码中引用正确的文档。任何帮助都非常非常欢迎！ :-)我已经花了几天时间，试图找出答案...

错误发生在“ Selection.EndKey ....”点。我知道这是因为我在Access中的Word中引用了该选择-我似乎无法弄清楚如何正确引用该选择，因此它在“ wDoct”文档中进行了引用。该选择仅采用最后一行并将其变为粗体，然后将1 Tab移至右侧并插入更多数据。也欢迎任何其他更好的方法来解决此问题。正如您所看到的，我才刚刚开始学习它；-)

Public Sub ExportToWord()


Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wDoct As Word.Document
Dim rs As DAO.Recordset
Dim exApp As Excel.Application
Dim exWb As Excel.Workbook
Dim exWs As Excel.Worksheet
Dim nextrow As Long
Dim rng As Word.Range

Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Users\Peter\Documents\testdoc.docm", ReadOnly:=False)
Set wDoct = wApp.Documents.Open("C:\Users\Peter\Documents\Trends.docx")
Set rs = CurrentDb.OpenRecordset("Overall")
Set exApp = New Excel.Application
Set exWb = exApp.Workbooks.Open("C:\Users\Peter\Documents\727TRACKER.xlsx", ReadOnly:=False)
Set exWs = exWb.Worksheets("MIS")


If Not rs.EOF Then rs.MoveLast

wDoc.Bookmarks("name").Range.Text = Nz(rs!Name, "")

nextrow = exWs.Cells(exWs.Rows.Count, "A").End(xlUp).Row + 1 'select last row in tracker
exWs.Range("A" & nextrow).Value = Nz(rs!Name, "")  'insert to last row

wDoct.Content.InsertAfter Text:=vbCr & Nz(rs!Name, "") & "date" 'insert last row in Word
Selection.EndKey Unit:=wdStory  'this is where it fails (select last row in and make bold)
Selection.MoveStart Unit:=wdLine, Count:=-1
Set rng = Selection.Range

With rng.Font
    .Bold = True
End With

Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=vbTab
Selection.Font.Bold = wdToggle
Selection.TypeText Text:=Nz(rs!Name, "")


Set rs = CurrentDb.OpenRecordset("Grades")

If Not rs.EOF Then rs.MoveLast

wDoc.Bookmarks("briefQ").Range.Text = Nz(rs!PlanQ, "")
wDoc.Bookmarks("briefQmin").Range.Text = Nz(rs!PlanQMin, "")

With wDoc.Content.Find
    .Text = "True"
    .Replacement.Text = "X"
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll

End With

With wDoc.Content.Find
    .Text = "False"
    .Replacement.Text = ""
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll

End With

Dim ctlList As Control, strItems As String, index As Integer

Set ctlList = Forms!Grades1!List96

For index = 0 To ctlList.ListCount - 1
 If ctlList.Selected(index) Then
 strItems = strItems & ctlList.Column(0, _
 index) & ";"
 End If
 Next index

wDoc.Bookmarks("type").Range.Text = strItems

wApp.DisplayAlerts = False
wDoc.SaveAs2 "C:\Users\Peter\Documents\" & rs!ID & "_gradesheet.docm"
wDoc.Close
wDoct.Save
wApp.Quit

exApp.DisplayAlerts = False
exWb.Close True

Set exWs = Nothing
Set exWb = Nothing
exApp.Quit
Set exApp = Nothing

Set wApp = Nothing
Set wDoc = Nothing
Set wDoct = Nothing
Set rng = Nothing


End Sub 

Answer 1

对于有兴趣的人，我改用此解决了它：

wDoct.Content.InsertAfter Text:=vbCr & Nz(rs!name, "") & "date" 'insert last row in          Word
wDoct.Content.InsertAfter Text:=vbTab & "name"
wDoct.Range(Start:=wDoct.Paragraphs.Last.Range.Start,     End:=wDoct.Paragraphs.Last.Range.Start + 10).Bold = True