Function IsFileExists(ByVal strFileName As String) As Boolean

    If Dir(strFileName, ) <> Empty Then

        IsFileExists = True

    Else

        IsFileExists = False

    End If

End Function

Sub setname()

    Dim I As Integer

    Dim J As Integer

    Dim pspname As String

    Dim pspnumber As String

    Dim tstname As String

    Dim tstnumber As String

    Dim path As String

    Dim srcPath As String

    Dim srcPath2 As String

    Dim headName As String

    Dim headName2 As String

    Dim txthead As String

    Dim wordApp As Object

    Dim wordDoc As Object

    Dim wordDoc2 As Object

    Dim wordArange As Object

    Dim wordSelection As Object

    Dim ReplaceSign As Boolean

    Dim Search1 As String

    Dim Search2 As String

    Dim docPrefix As String

    Dim docSuffix As String

    Dim rangSize As Integer

    Dim stringTable1 As String

    'docPrefix = "-PSP"

    'docSuffix = "采购规格书.doc"

    'Search1 = "电线"

    'Search2 = "6000397-PSP"

    'rangSize = 200

    docPrefix = "-"

    docSuffix = "入场检验报告.doc"

    Search1 = "高压电源"

    Search2 = "6000000-TST"

    'Search1 = "AC-DC开关电源"

    'Search2 = "6000412-TST"

    rangSize = 

    J =

    Dim myItem

    'myItem = Array(14, 16, 17, 18, 22, 23, 24, 26, 27, 31, 32, 33, 34, 35, 36, 48, 50, 55, 56, 62, 63, 64, 65, 66, 67, 68, 69, 71, 73, 77, 79, 102, 114, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 172, 173, 174, 175, 176, 177, 179, 180, 181)

    For I =  To

        'srcPath = "C:\cygwin\tmp\BOM\tst16.doc"

        'If ActiveSheet.Cells(I, 5) = "" Then

        '    headName2 = ActiveSheet.Cells(I, 3) & "-" & ActiveSheet.Cells(I, 4) & "-" & ActiveSheet.Cells(I, 5)

        '    headName = headName2 & docSuffix

        '    headName3 = ActiveSheet.Cells(I, 4)

        'Else

        '    headName2 = ActiveSheet.Cells(I, 3) & "-" & ActiveSheet.Cells(I, 4) & "-" & ActiveSheet.Cells(I, 6)

        '    headName = headName2 & docSuffix

        '    headName3 = ActiveSheet.Cells(I, 4) & "（" & ActiveSheet.Cells(I, 5) & "）"

        'End If

        'headName = Replace(headName, "/", "-")

        path = "D:\bom\"

        srcPath2 = path & "\aa.doc"

        'pspname = path & "\" & ActiveSheet.Cells(I, 3) & docPrefix & ActiveSheet.Cells(I, 4) & docSuffix

        pspname = "D:\bom\" & ActiveSheet.Cells(I, ) & "-PSP-V1.0.doc"

        tstname = "D:\bom\" & ActiveSheet.Cells(I, ) & "-TST-V1.0.doc"

        tstnumber = ActiveSheet.Cells(I, ) & "-TST"

        headName = ActiveSheet.Cells(I, )

        headName2 = ActiveSheet.Cells(I, )

        pspname2 = "D:\bom\aa\" & ActiveSheet.Cells(I, ) & "-PSP-V1.0.doc"

        If IsFileExists(pspname) = True Then

            'FileCopy srcPath, srcPath2

            'Name srcPath2 As tstname

            'headName = ActiveSheet.Cells(I, 4).Value

            'headName2 = ActiveSheet.Cells(I, 3)

            Set wordApp = CreateObject("Word.Application")                  '建立WORD实例

            wordApp.Visible = False                                         '屏蔽WORD实例窗体

            Set wordDoc = wordApp.Documents.Open(pspname)                   '打开文件并赋予文件实例

            'Set wordSelection = wordApp.Selection                           '定位文件实例

            'Set wordArange = wordApp.ActiveDocument.Range(0, rangSize)      '指定文件编辑位置

            'wordArange.Select                                               '激活编辑位置

            'stringTable1 = wordDoc.Tables(4).Cell(2, 1)

            Set wordDoc2 = wordApp.Documents.Open(pspname2)

            'stringTable1 = Trim(wordDoc.Tables(1).Cell(2, 2).Range.Text)

            'wordDoc2.Tables(1).Cell(2, 2) = wordDoc.Tables(1).Cells(2, 2)

            wordDoc2.Tables().Cell(, ).Range.Text = Replace(wordDoc.Tables().Cell(, ).Range.Text, Chr(), "")

            wordDoc2.Tables().Cell(, ).Range.Text = Replace(wordDoc.Tables().Cell(, ).Range.Text, Chr(), "")

            wordDoc2.Tables().Cell(, ).Range.Text = Replace(wordDoc.Tables().Cell(, ).Range.Text, Chr(), "")

            wordDoc2.Tables().Cell(, ).Range.Text = Replace(wordDoc.Tables().Cell(, ).Range.Text, Chr(), "")

            wordDoc2.Tables().Cell(, ).Range.Text = Replace(wordDoc.Tables().Cell(, ).Range.Text, Chr(), "")

            wordDoc2.Tables().Cell(, ).Range.Text = Replace(wordDoc.Tables().Cell(, ).Range.Text, Chr(), "")

            wordDoc2.Tables().Cell(, ).Range.Text = headName2

            wordDoc2.Tables().Cell(, ).Range.Text = "件"

            'wordDoc2.Tables(2).Cell(2, 2).Range.Text = Replace(wordDoc.Tables(2).Cell(3, 2).Range.Text, Chr(13), "")

            wordDoc2.Tables().Cell(, ).Range.Text = Replace(wordDoc.Tables().Cell(, ).Range.Text, Chr(), "")

            wordDoc2.Tables().Cell(, ).Range.Text = Replace(wordDoc.Tables().Cell(, ).Range.Text, Chr(), "")

            wordDoc2.Tables().Cell(, ).Range = wordDoc.Tables().Cell(, ).Range

            wordDoc.Save

            wordDoc.Close True

            wordDoc2.Save

            wordDoc2.Close True

            wordApp.Quit

            J = J +

        End If

    Next I

End Sub