依据BOM和已经存在的文件生成其他种类的文件

Function IsFileExists(ByVal strFileName As String) As Boolean
    If Dir(strFileName, 16) <> Empty Then
        IsFileExists = True
    Else
        IsFileExists = False
    End If
End Function

Sub setname()
    Dim I 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 wordApp As Object
    Dim wordDoc 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
        
    ‘docPrefix = "-PSP"
    ‘docSuffix = "采购规格书.doc"
    ‘Search1 = "电线"
    ‘Search2 = "6000397-PSP"
    ‘rangSize = 200
    
    docPrefix = "-"
    docSuffix = "入场检验报告.doc"
    Search1 = "高压电源"
    Search2 = "6000000-TST"
    ‘Search1 = "AC-DC开关电源"
    ‘Search2 = "6000412-TST"
    rangSize = 50
    
    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 = 1 To 183
        srcPath = "C:\cygwin\tmp\BOM\pqc.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, 3) & "-INS-V1.0.doc"
        tstname = "D:\bom\" & headName2 & "过程检验报告.doc"
        tstnumber = ActiveSheet.Cells(I, 3) & "-TST"
        
        If IsFileExists(pspname) = True Then
            FileCopy srcPath, srcPath2
            Name srcPath2 As tstname
            
            Set wordApp = CreateObject("Word.Application")                  ‘建立WORD实例
            wordApp.Visible = False                                         ‘屏蔽WORD实例窗体
            Set wordDoc = wordApp.Documents.Open(tstname)                   ‘打开文件并赋予文件实例
            Set wordSelection = wordApp.Selection                           ‘定位文件实例
            Set wordArange = wordApp.ActiveDocument.Range(0, rangSize)      ‘指定文件编辑位置
            wordArange.Select                                               ‘激活编辑位置
            
            Do
                ReplaceSign = wordArange.Find.Execute("XXX", True, , , , , wdReplaceAll, wdFindContinue, , headName2, True)
            Loop Until ReplaceSign = False
                    
                      
                      
            ‘For Each rngStory In wordDoc.StoryRanges
            ‘  Do
            ‘    ReplaceSign = rngStory.Find.Execute(Search2, True, , , , , wdReplaceAll, wdFindContinue, , tstnumber, True)
            ‘    Set rngStory = rngStory.NextStoryRange
            ‘  Loop Until rngStory Is Nothing
            ‘Next
          
            
            wordDoc.Save
            wordDoc.Close True
            wordApp.Quit
        End If
    Next I

End Sub