SubSetName ()DimI as Integer DimPspname as String DimPspnumber as String DimPath as String DimSrcpath as String DimSrcPath2 as String DimWordApp as Object DimWordDoc as Object DimWordarange as Object DimWordselection as Object DimReplacesign as Boolean DimSearch1 as String DimSearch2 as String DimDocprefix as String DimDocsuffix as String DimRangsize as Integer 'docprefix = "-PSP" 'docsuffix = "Purchase spec. doc" 'Search1 = "Wire" 'SEARCH2 = "6000397-PSP" 'rangsize =Docprefix="-tst"Docsuffix="incoming inspection specification. doc"Search1="High voltage power supply"SEARCH2="6000391-tst"rangsize= 1100 forI =4 to 5Srcpath="C:\cygwin\tmp\BOM\tst.doc"Path="D:\bom\"& ActiveSheet.Cells (I,3) &"-"& ActiveSheet.Cells (I,4) SrcPath2= Path &"\aa.doc"Pspname= Path &"\"& ActiveSheet.Cells (I,3) & Docprefix &" "& ActiveSheet.Cells (I,4) &Docsuffix Pspnumber= ActiveSheet.Cells (I,3) &DocprefixMkDir(PATH)FileCopySrcpath, srcPath2 Name srcPath2 asPspnameSetWordApp =CreateObject("Word.Application")'Create a Word instanceWordapp.visible =False 'block Word instance forms SetWordDoc = WordApp.Documents.Open (pspname)'Open the file and give the file instance SetWordselection = Wordapp.selection'Locating file Instances SetWordarange = WordApp.ActiveDocument.Range (0, rangsize)'Specify file Edit locationWordarange.select'Activate edit Location Doreplacesign= WordArange.Find.Execute (Search1,True,,,,, wdReplaceAll, Wdfindcontinue,, ActiveSheet.Cells (I,4),True) Loop UntilReplacesign =False DimRngstory as Object DimLngjunk as Long for eachRngstoryinchworddoc.storyranges Doreplacesign= RngStory.Find.Execute (SEARCH2,True,,,,, wdReplaceAll, Wdfindcontinue,, Pspnumber,True) SetRngstory =Rngstory.nextstoryrangeLoop UntilRngstory is Nothing NextWorddoc.save Worddoc.closeTrueWordapp.quitNextIEnd Sub
Generate the corresponding Word document based on the contents of Excel and the Word template