在BOM中记录中有物料编码，物料名称，物料规格等，而且依据BOM已经生成了相应的文件，如采购规格书，检验规格书等，这个时候需要获得这些文件的标题，并且生成一个列表，可以使用下面的VBA代码，具体代码如下：
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 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 = 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, ) = "" Then
headName2 = ActiveSheet.Cells(I, ) & "-" & ActiveSheet.Cells(I, ) & "-" & ActiveSheet.Cells(I, )
headName = headName2 & docSuffix
headName3 = ActiveSheet.Cells(I, )
Else
headName2 = ActiveSheet.Cells(I, ) & "-" & ActiveSheet.Cells(I, ) & "-" & ActiveSheet.Cells(I, )
headName = headName2 & docSuffix
headName3 = ActiveSheet.Cells(I, ) & "（" & ActiveSheet.Cells(I, ) & "）"
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, ) & "-TST-V1.0.doc"
tstname = "D:\bom\" & ActiveSheet.Cells(I, ) & "-TST-V1.0.doc"
tstnumber = ActiveSheet.Cells(I, ) & "-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(, 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, ) = tstnumber
ActiveSheet.Cells(I, ) = txthead ActiveSheet.Cells(J, ) = tstnumber
ActiveSheet.Cells(J, ) = txthead
J = J +
End If
Next I End Sub