根据BOM和已存在的文件生成文件列表

在BOM中记录中有物料编码，物料名称，物料规格等，而且依据BOM已经生成了相应的文件，如采购规格书，检验规格书等，这个时候需要获得这些文件的标题，并且生成一个列表，可以使用下面的VBA代码，具体代码如下：

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 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 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 = 60

    J = 1
    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 187
        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, 3) & "-TST-V1.0.doc"
        tstname = "D:\bom\" & ActiveSheet.Cells(I, 3) & "-TST-V1.0.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                                               ‘激活编辑位置

            txthead = wordArange
            txthead = Application.WorksheetFunction.Clean(txthead)
            txthead = Trim(txthead)

            ‘Do
            ‘    ReplaceSign = wordArange.Find.Execute("XXX", True, , , , , wdReplaceAll, wdFindContinue, , headName3, 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
            ActiveSheet.Cells(I, 12) = tstnumber
            ActiveSheet.Cells(I, 13) = txthead

            ActiveSheet.Cells(J, 15) = tstnumber
            ActiveSheet.Cells(J, 16) = txthead
            J = J + 1
        End If
    Next I

End Sub