Private Sub Command6_Click()
    Dim i As Integer
    Dim j As Integer
    Dim tuhao As String
    Dim tuming As String
   
    Dim wrdapp As Object
    Dim wrddoc As Object
    Set wrdapp = CreateObject("word.application")
    Set wrddoc = wrdapp.Documents.Open(Text6.Text)


    Dim k As Integer
    Dim A As Integer
   
    Dim Myname As String
    Dim Mynamewuhouzhui As String
    Dim Mynamehouzhui As String
   
    Dim Myname2 As String
    Dim Mypath As String
    Dim Mypathname As String
    Dim Mypathname2 As String
    pltjtm.List2.Clear
   
    For k = 0 To List1.ListCount - 1
            Mypathname = List1.List(k)
            Mypath = Mid(Mypathname, 1, InStrRev(Mypathname, "\") - 1)
            Myname = Right(Mypathname, Len(Mypathname) - InStrRev(Mypathname, "\"))
            Mynamewuhouzhui = Mid(Myname, 1, InStrRev(Myname, ".") - 1)
            Mynamehouzhui = Right(Myname, Len(Myname) - InStrRev(Myname, "."))
            For i = 1 To 5
                For j = 13 To 28
                    tuhao = wrddoc.Tables(i).Cell(j, 2).Range.Text
                    tuhao = Left(tuhao, Len(tuhao) - 1)

                    A = InStr(Mynamewuhouzhui, tuhao)

                    If A > 0 Then
                        tuming = wrddoc.Tables(1).Cell(j, 3).Range.Text
                        tuming = Left(tuming, Len(tuming) - 1)
                    
                        Myname2 = Replace(Mynamewuhouzhui, Mynamewuhouzhui, Mynamewuhouzhui & " " & tuming & "." & Mynamehouzhui)
                        Name Mypath & "\" & Myname As Mypath & "\" & Myname2
                        pltjtm.List2.AddItem Mypath & "\" & Myname2
                        GoTo 11
                    End If
                Next
            Next

11:
    Next
   
    wrddoc.Close
    wrdapp.Quit

End Sub

能再问下，为何要  -2  ？您是如何发现这种解决办法的？

也非常感谢您的指导，我之前有几篇帖子，您很早之前也都指点过。在这里表示下感谢。