批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

[原创] 学习vbs后的练习代码

前段时间学习了vbs,我的习惯是学习一门新的语言之后,得想方设法用它完成一个比较困难的任务,于是写了一个工作中可以用到的脚本,已经在部门内分发,反响不错。代码没什么通用性,大致是完成一些Excel表格的制作和文本文件与Excel的比对,与工作相关了。贴出来的目的,有作秀的成分,也有与vbs同学共勉的成分,最想的还是鼓励大家写一些较大型的程序,这样我们会接触到更多关于代码规范性和结构化的东西。本人仅菜鸟一枚,不必膜拜。
  1. option explicit
  2. 'On Error Resume Next
  3. dim strPrompt             'function table string
  4. dim intFunction 'holds user's choice
  5. dim strChoices 'characters user can enter
  6. dim objShell 'WScript shell object
  7. dim fso 'File system object
  8. dim setupfile 'setup file for this script
  9. const ForReading=1 'ForWriting=2, ForAppending=8
  10. dim i,item 'variables to walk through an array or loop
  11. strPrompt="Choose a function from the table:" & vbNewLine &vbNewLine &_
  12. "1. Generate CIS Pre-BOM." & vbNewLine &_
  13. "2. Compare CIS and PDM BOMs." & vbNewLine &_
  14. "3. Generate HDL Pre-BOM." & vbNewLine &_
  15. "4. Compare HDL and PDM BOMs." & vbNewLine &_
  16. "5. Compare two PDM BOMs." & vbNewLine
  17. strChoices="12345"
  18. set objShell=CreateObject("WScript.Shell")
  19. set fso=CreateObject("scripting.FileSystemObject")
  20. setupfile=objShell.CurrentDirectory & "\setup.ini"
  21. 'function table
  22. do
  23. intFunction=InputBox(strPrompt,"Function Table",1)
  24. if intFunction="" then WScript.Quit
  25. loop until InStr(strChoices,Left(intFunction,1))
  26. select case CInt(Left(intFunction,1))
  27. case 1
  28. call preBOM(1)
  29. case 2
  30. call Compare(1)
  31. case 3
  32. call preBOM(2)
  33. case 4
  34. call Compare(2)
  35. case 5
  36. call Compare(3)
  37. case else
  38. MsgBox "Runtime error, program will exit.", _
  39. vbOKOnly+vbExclamation,"error"
  40. WScript.Quit
  41. end select
  42. '****************function and subroutine area***************
  43. 'sub to read text bom file to generate pre-Bom
  44. 'CISorHDL identify the type of the text BOM, 1=CIS and 2=HDL
  45. sub preBOM(CISorHDL)
  46. dim StartLine,PartNumber,Quantity, _
  47. IsPOP,NPOP,HeaderLine,Location, _
  48. SmdPN,DipPN,PcbPN 'values read from setup.ini
  49. dim dictSetup 'dictionary holding setup information
  50. dim arrCheckSetup 'holds all needed setup strings
  51. dim bomFile                                 'points to the bom file
  52. dim dictParts 'dictionary holds all parts, keys are part numbers
  53. 'and items are class part objects
  54. dim strBegin 'identify the beginning of information scope
  55. dim strEnd 'idenfity the end of information scope
  56. 'veriry preBOM type
  57. if CISorHDL=1 then
  58. strBegin="<CIS_preBOM>"
  59. strEnd="</CIS_preBOM>"
  60. elseif CISorHDL=2 then
  61. strBegin="<HDL_preBOM>"
  62. strEnd="</HDL_preBOM>"
  63. end if
  64. 'check if all necessary information is aquired from setup.ini
  65. arrCheckSetup=Array("StartLine","PartNumber","Quantity","IsPOP", _
  66. "Location","NPOP","HeaderLine","SmdPN","DipPN","PcbPN")
  67. set dictSetup=ReadSetup(setupfile,strBegin,strEnd)
  68. for each item in arrCheckSetup
  69. if not dictSetup.Exists(item) then
  70. MsgBox "No """ & item & """ value found in " &_
  71. setupfile & ", please check your file.", _
  72. vbOkOnly+vbCritical,"Error"
  73. end if
  74. Execute(item & "=dictSetup.item(""" & item & """)")
  75. next
  76. 'let user choose bom file
  77. 'if user clicks CANCEL, program exists
  78. bomFile=BrowseForFile()
  79. if bomFile="" then
  80. WScript.Quit
  81. end if
  82. 'begin to read parts
  83. set dictParts=CreateObject("scripting.Dictionary")
  84. set dictParts=ReadTextParts(bomFile,HeaderLine,StartLine,PartNumber,Quantity,IsPOP,Location,NPOP,",")
  85. 'write part dictionary to Excel
  86. call WriteToExcel(dictParts,SmdPN,DipPN,PcbPN)
  87. end sub
  88. 'sub to compare text bom file with excel bom or two excel boms
  89. 'CompareType identify the comparision, 1=CIS_PDM and 2=HDL_PDM and 3=twoPDM
  90. sub Compare(CompareType)
  91. dim StartLine,PartNumber,Quantity, _
  92. IsPOP,NPOP,HeaderLine,Location,ExcelHeaderLine, _
  93. ExcelStartLine,ExcelPartNumber,_
  94. ParentPN,ExcelQuantity, _
  95. ExcelLocation,ExcelLevel 'values read from setup.ini
  96. dim dictSetup 'dictionary holding setup information
  97. dim arrCheckSetup 'holds all needed setup strings
  98. dim FirstFile                               'points to the first bom file
  99. dim SecondFile 'points to the second bom file
  100. dim dictFirstParts 'dictionary holds the first part dictionary
  101. dim dictSecondParts 'dictionary holds the first part dictionary
  102. 'and items are class part objects
  103. dim strBegin 'identify the beginning of information scope
  104. dim strEnd 'idenfity the end of information scope
  105. dim strPrompt 'string shown on MsgBox or InputBox
  106. 'veriry preBOM type
  107. if CompareType=1 then
  108. strBegin="<CIS_PDM>"
  109. strEnd="</CIS_PDM>"
  110. arrCheckSetup=Array("StartLine","PartNumber","Quantity","IsPOP", _
  111. "Location","NPOP","HeaderLine","ExcelHeaderLine", _
  112. "ExcelStartLine","ExcelPartNumber","ParentPN","ExcelQuantity", _
  113. "ExcelLocation","ExcelLevel")
  114. elseif CompareType=2 then
  115. strBegin="<HDL_PDM>"
  116. strEnd="</HDL_PDM>"
  117. arrCheckSetup=Array("StartLine","PartNumber","Quantity","IsPOP", _
  118. "Location","NPOP","HeaderLine","ExcelHeaderLine", _
  119. "ExcelStartLine","ExcelPartNumber","ParentPN","ExcelQuantity", _
  120. "ExcelLocation","ExcelLevel")
  121. elseif CompareType=3 then
  122. strBegin="<twoPDM>"
  123. strEnd="</twoPDM>"
  124. arrCheckSetup=Array("ExcelHeaderLine", _
  125. "ExcelStartLine","ExcelPartNumber","ParentPN","ExcelQuantity", _
  126. "ExcelLocation","ExcelLevel")
  127. else
  128. Err.Raise 104,"BomKit check error.","BomKit doesn't support this kind of comparison: " & CompareType
  129. end if
  130. 'check if all necessary information is aquired from setup.ini
  131. set dictSetup=ReadSetup(setupfile,strBegin,strEnd)
  132. for each item in arrCheckSetup
  133. if not dictSetup.Exists(item) then
  134. MsgBox "No """ & item & """ value found in " &_
  135. setupfile & ", please check your file.", _
  136. vbOkOnly+vbCritical,"Error"
  137. end if
  138. Execute(item & "=dictSetup.item(""" & item & """)")
  139. next
  140. 'let user choose 2 bom files
  141. 'if user clicks CANCEL, program exists
  142. select case CompareType
  143. case 1
  144. strPrompt="You are going to choose the BOM file generated by Allegro CIS."
  145. case 2
  146. strPrompt="You are going to choose the BOM file generated by Allegro HDL."
  147. case 3
  148. strPrompt="You are going to choose the excel file downloaded from PDM."
  149. end select
  150. MsgBox strPrompt,vbInformation,"Note"
  151. FirstFile=BrowseForFile()
  152. if FirstFile="" then
  153. WScript.Quit
  154. end if
  155. 'begin to read first bom
  156. set dictFirstParts=CreateObject("scripting.Dictionary")
  157. set dictSecondParts=CreateObject("scripting.Dictionary")
  158. if CompareType=1 or CompareType=2 then
  159. set dictFirstParts=ReadTextParts(FirstFile,HeaderLine,StartLine,PartNumber,Quantity,IsPOP,Location,NPOP,",")
  160. else
  161. set dictFirstParts=ReadExcelParts(FirstFile,ExcelHeaderLine,ExcelStartLine,ExcelPartNumber, _
  162. ParentPN,ExcelQuantity,ExcelLocation,ExcelLevel)
  163. end if
  164. strPrompt="You are going to choose the excel file downloaded from PDM."
  165. MsgBox strPrompt,vbInformation,"Note"
  166. SecondFile=BrowseForFile()
  167. if SecondFile="" then
  168. WScript.Quit
  169. end if
  170. 'begin to read second bom
  171. set dictSecondParts=ReadExcelParts(SecondFile,ExcelHeaderLine,ExcelStartLine,ExcelPartNumber, _
  172. ParentPN,ExcelQuantity,ExcelLocation,ExcelLevel)
  173. 'begin to compare the two dictionaries
  174. dim arrCompare
  175. arrCompare=CompareDicts(dictFirstParts,dictSecondParts)
  176. dim fso,objTextStream,objShell,re
  177. set re=new RegExp
  178. re.Pattern="[\n\r]+$"
  179. set fso=CreateObject("scripting.FileSystemObject")
  180. set objShell=CreateObject("WScript.Shell")
  181. set objTextStream=fso.OpenTextFile(objShell.CurrentDirectory & "\compare.txt",2,true)
  182. objTextStream.WriteLine "Comparision results generated by BomKit"
  183. objTextStream.WriteLine Date & " " & Time & vbNewLine
  184. objTextStream.WriteLine "Below items exist only in " & FirstFile & vbNewLine & String(80,"=")
  185. objTextStream.Write re.Replace(arrCompare(0),"") & vbNewLine & String(80,"=") & vbNewLine & vbNewLine & vbNewLine
  186. objTextStream.WriteLine "Below items exist only in " & SecondFile & vbNewLine & String(80,"=")
  187. objTextStream.Write re.Replace(arrCompare(1),"") & vbNewLine & String(80,"=") & vbNewLine & vbNewLine & vbNewLine
  188. objTextStream.WriteLine "Below are mismatched items" & vbNewLine & String(80,"=")
  189. objTextStream.Write re.Replace(arrCompare(2),"") & vbNewLine & String(80,"=") & vbNewLine & vbNewLine & vbNewLine
  190. objTextStream.Close
  191. objShell.Run(objShell.CurrentDirectory & "\compare.txt")
  192. end sub
  193. 'function to let user choose a file
  194. function BrowseForFile()
  195.     dim shell : set shell = CreateObject("WScript.Shell")
  196.     dim fso : set fso = CreateObject("Scripting.FileSystemObject")
  197.     dim tempFolder : set tempFolder = fso.GetSpecialFolder(2)
  198.     dim tempName : tempName = fso.GetTempName()
  199.     dim tempFile : set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
  200.     tempFile.Write _
  201.     "<html>" & _
  202.     "<head>" & _
  203.     "<title>Browse</title>" & _
  204.     "</head>" & _
  205.     "<body>" & _
  206.     "<input type='file' id='f' />" & _
  207.     "<script type='text/javascript'>" & _
  208.     "var f = document.getElementById('f');" & _
  209.     "f.click();" & _
  210.     "var shell = new ActiveXObject('WScript.Shell');" & _
  211.     "shell.RegWrite('HKEY_CURRENT_USER\\Volatile Environment\\MsgResp', f.value);" & _
  212.     "window.close();" & _
  213.     "</script>" & _
  214.     "</body>" & _
  215.     "</html>"
  216.     tempFile.Close
  217.     shell.Run tempFolder & "\" & tempName & ".hta", 0, true
  218.     BrowseForFile = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
  219.     shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
  220. end function
  221. 'read configuration information from the file specified by strSetupfile
  222. 'strBegin and strEnd identify the information scope
  223. 'returns a dictionary containing configuration information
  224. function ReadSetup(strSetupfile,strBegin,strEnd)
  225. dim objTextStream,strLine,IsReading,fso    'For reading setup file
  226. const ForReading=1        'ForWriting=2, ForAppending=8
  227. dim re        'regular expression
  228. dim dictSetup,arrLine    'dictionary holding setup information
  229. set fso=CreateObject("scripting.FileSystemObject")
  230. set objTextStream=fso.OpenTextFile(strSetupfile,ForReading,false,-2)
  231. set dictSetup=CreateObject("scripting.Dictionary")
  232. IsReading=false
  233. strLine=Empty
  234. set re=new RegExp
  235. re.Pattern="=([^\t]+)\t+'.*$"
  236. do
  237. strLine=objTextStream.ReadLine
  238. if UCase(strLine)=UCase(strEnd) then IsReading=false
  239. if IsReading then
  240. strLine=re.Replace(strLine,"=$1")
  241. arrLine=split(strLine,"=")
  242. dictSetup.Add arrLine(0),arrLine(1)
  243. end if
  244. if UCase(strLine)=UCase(strBegin) then IsReading=true
  245. loop until strLine=strEnd or objTextStream.AtEndOfStream
  246. objTextStream.Close
  247. set ReadSetup=dictSetup
  248. end function
  249. 'sub to write specific information to setup.ini
  250. 'strBegin and strEnd identify the information scope
  251. 'strKey and strValue identify where and what
  252. sub WriteSetup(strSetupfile,strBegin,strEnd,strKey,strValue)
  253. dim objTextStream,strLine,IsReading,arrLine,fso,item
  254. const ForReading=1,ForWriting=2
  255. dim re
  256. set fso=CreateObject("scripting.FileSystemObject")
  257. set objTextStream=fso.OpenTextFile(strSetupFile,ForReading,false,-2)
  258. strLine=objTextStream.ReadAll
  259. objTextStream.Close
  260. arrLine=Split(strLine,vbNewLine)
  261. set objTextStream=fso.OpenTextFile(strSetupFile,ForWriting)
  262. IsReading=false
  263. set re=new RegExp
  264. re.Pattern="^" & strKey & "=[^\t]*(\t+'.*$)"
  265. re.IgnoreCase=true
  266. for each item in arrLine
  267. strLine=item
  268. if UCase(item)=UCase(strEnd) then IsReading=false
  269. if IsReading and UCase(Left(strLine,Len(strKey)))=UCase(strKey) then
  270. strLine=re.Replace(strLine,strKey & "=" & strValue & "$1")
  271. end if
  272. if UCase(item)=UCase(strBegin) then IsReading=true
  273. objTextStream.WriteLine strLine
  274. next
  275. objTextStream.Close
  276. end sub
  277. 'function to read parts to a dictionary from the file specified by strFile
  278. 'HeaderLine identifies the header line number
  279. 'StartLine identifies the first line to start to read
  280. 'dictColumn contains column numbers of PartNumber,Quantity,IsPOP,Location
  281. 'PartNumber,Quantity,IsPOP,Location refers to column names
  282. 'strNPOP contains those values make a part NPOP
  283. 'chrSepar specifies location separator
  284. function ReadTextParts(strFile,HeaderLine,StartLine,PartNumber,Quantity,IsPOP,Location,strNPOP,chrSepar)
  285. dim fso,objTextStream,arrLine,strLine,i,dictParts,strPrompt
  286. set dictParts=CreateObject("scripting.Dictionary")
  287. set fso=CreateObject("scripting.FileSystemObject")
  288. set objTextStream=fso.OpenTextFile(strFile,ForReading,false,-2)
  289. 'check bom file format
  290. 'skip useless lines
  291. for i=2 to HeaderLine
  292. objTextStream.SkipLine
  293. next
  294. strLine=objTextStream.ReadLine
  295. for each item in Array(PartNumber,Quantity,IsPOP,Location)
  296. if not IncludesItemOf(strLine,item) then
  297. MsgBox "BOM file format check failed." & vbNewLine &_
  298. "Expect """ & Join(Split(item,","),""" or """) & """ on line " & HeaderLine &_
  299. " of " & strFile & "." & vbNewLine &vbNewLine &_
  300. "Solutions:" & vbNewLine &_
  301. "1.Check value of ""HeaderLine"" in setup.ini;" &_
  302. vbNewLine & "2.Check your bom file " & strFile & ".", _
  303. vbOkOnly+vbCritical,"Error"
  304. WScript.Quit
  305. end if
  306. next
  307. 'get column numbers to a dictionary
  308. 'dictColumn.Item("NPOP") coantains all NPOP column numbers, separated by comma
  309. dim dictColumn 'dictionary to hold column numbers(0-based), keys are column name strings
  310. set dictColumn=CreateObject("scripting.Dictionary")
  311. arrLine=split(strLine,vbTab)
  312. for i=0 to UBound(arrLine)
  313. select case arrLine(i)
  314. case PartNumber
  315. dictColumn.Add PartNumber,i
  316. case Quantity
  317. dictColumn.Add Quantity,i
  318. case Location
  319. dictColumn.Add Location,i
  320. case else
  321. if IncludesItemOf(arrLine(i),IsPOP) then
  322. if not dictColumn.Exists("NPOP") then
  323. dictColumn.Add "NPOP",Cstr(i)
  324. else
  325. dictColumn.Item("NPOP")=dictColumn.Item("NPOP") & "," & CStr(i)
  326. end if
  327. end if
  328. end select
  329. next
  330. 'skip useless lines
  331. for i=1 to StartLine-HeaderLine-1
  332. objTextStream.SkipLine
  333. next
  334. 'begin to read
  335. do until objTextStream.AtEndOfStream
  336. strLine=objTextStream.ReadLine
  337. dim currentPN 'current part number
  338. dim objPart 'a 'part' object to hold each part's information
  339. arrLine=split(strLine,vbTab)
  340. if not PartIsNPOP(arrLine,dictColumn.Item("NPOP"),strNPOP) then
  341. 'if this part is not NPOP
  342. if not arrLine(dictColumn.item(PartNumber))="" then
  343. 'if part number column is not empty
  344. currentPN=arrLine(dictColumn.item(PartNumber))
  345. if not dictParts.Exists(currentPN) then
  346. 'if current part number is new
  347. set objPart=new part
  348. objPart.PartNumber=arrLine(dictColumn.item(PartNumber))
  349. objPart.Quantity=arrLine(dictColumn.item(Quantity))
  350. objPart.Location=arrLine(dictColumn.item(Location))
  351. dictParts.Add currentPN,objPart
  352. else
  353. 'if current part number is old
  354. dictParts.item(currentPN).Quantity= _
  355. dictParts.item(currentPN).Quantity+ _
  356. arrLine(dictColumn.item(Quantity))
  357. dictParts.item(currentPN).Location= _
  358. dictParts.item(currentPN).Location & "," & _
  359. arrLine(dictColumn.item(Location))
  360. end if
  361. else
  362. 'if part number column is empty
  363. 'append location string
  364. if not IsEmpty(currentPN) then
  365. dictParts.item(currentPN).Location= _
  366. dictParts.item(currentPN).Location &_
  367. arrLine(dictColumn.item(Location))
  368. end if
  369. end if
  370. else
  371. 'if part is NPOP, clear currentPN
  372. currentPN=Empty
  373. end if
  374. loop
  375. 'delete ZZ and empty part numbers from the dictionary
  376. 'and check repeated locations
  377. dim strAllLocations                 'string to hold all locations
  378. for each item in dictParts.Items
  379. if item.IsBadPN() then
  380. dictParts.Remove(item.PartNumber)
  381. else
  382. strAllLocations=strAllLocations & "," & item.Location
  383. end if
  384. next
  385. dim dictRepeat 'dictionary to hold repeated items and times
  386. set dictRepeat=CreateObject("scripting.Dictionary")
  387. set dictRepeat=CheckRepeat(strAllLocations,",")
  388. if dictRepeat.Count>0 then
  389. strPrompt=Empty
  390. strPrompt="BomKit detects repeated locations:" & vbNewLine &_
  391. vbNewLine & "Location" & vbTab & vbTab & "Repeat Times" & vbNewLine
  392. for each item in dictRepeat.Keys
  393. strPrompt=strPrompt &_
  394. item & vbTab & vbTab & dictRepeat.Item(item) & vbNewLine
  395. next
  396. MsgBox strPrompt,vbOkOnly+vbCritical,"Error"
  397. WScript.Quit
  398. end if
  399. 'check partnumber quantities' correctness
  400. strPrompt=Empty
  401. for each item in dictParts.Items
  402. if not item.CheckQty then
  403. strPrompt=strPrompt & item.PartNumber & String(2,vbTab) &_
  404. item.Quantity & vbTab & item.RealQty() & vbNewLine
  405. item.CorrectQty
  406. end if
  407. next
  408. if not IsEmpty(strPrompt) then
  409. strPrompt="BomKit detects wrong quantities, modified automatically:" & vbNewLine &_
  410. vbNewLine & "Part number" & String(2,vbTab) & "Read" & vbTab &_
  411. "Real" & vbNewLine & strPrompt
  412. MsgBox strPrompt,vbInformation,"Wrong Quantity"
  413. end if
  414. objTextStream.Close
  415. set ReadTextParts=dictParts
  416. end function
  417. 'function to check repeated items, separated by strSepar, in string specified by strTest
  418. 'return a dictionary to hold these items, keys are items, items are repeating times
  419. function CheckRepeat(strTest,strSepar)
  420. dim strToCheck
  421. strToCheck=strTest
  422. if not Left(strToCheck,1)=strSepar then strToCheck=strSepar & strToCheck
  423. if not Right(strToCheck,1)=strSepar then strToCheck=strToCheck & strSepar
  424. dim dictRepeat
  425. set dictRepeat=CreateObject("scripting.Dictionary")
  426. for each item in split(strToCheck,strSepar)
  427. if InStr(strToCheck,strSepar & item & strSepar)<> _
  428.    InStrRev(strToCheck,strSepar & item & strSepar) then
  429. if dictRepeat.Exists(item) then
  430. dictRepeat.Item(item)=dictRepeat.Item(item)+1
  431. else
  432. dictRepeat.Add item,1
  433. end if
  434. end if
  435. next
  436. set CheckRepeat=dictRepeat
  437. end function
  438. 'function to check if strA(Tab as delimiter) includes any items of strB, which are separated by comma
  439. function IncludesItemOf(strA,strB)
  440. IncludesItemOf=false
  441. dim item,strLine
  442. strLine="," & Join(Split(strA,vbTab),",") & ","
  443. for each item in Split(strB,",")
  444. if Instr(strLine,"," & item & ",") then
  445. IncludesItemOf=true
  446. exit for
  447. end if
  448. next
  449. end function
  450. 'function to check if part is NPOP
  451. 'NPOPColumns contains related NPOP column numbers
  452. 'arrLine contains the split columns
  453. function PartIsNPOP(arrLine,NPOPColumns,strNPOP)
  454. dim item
  455. PartIsNPOP=false
  456. for each item in Split(NPOPColumns,",")
  457. if IncludesItemOf(arrLine(CInt(item)),strNPOP) then
  458. PartIsNPOP=true
  459. exit for
  460. end if
  461. next
  462. end function
  463. 'function to write part dictionary to Excel
  464. 'SmdPN,DipPN,PcbPN identify the part numbers read rom setup.ini
  465. sub WriteToExcel(dictParts,SmdPN,DipPN,PcbPN)
  466. dim strInput 'hold the string returned from InputBox
  467. dim arrInput 'array to hold split input string
  468. dim arrLine
  469. 'get smd/dip/pcb part numbers from user
  470. strInput=InputBox("Please enter SMD/DIP/PCB part numbers, separated by semicolons. Like:" &_
  471. vbNewLine & vbNewLine &_
  472. "55.5R101.S01G;55.5R101.D01G;48.5R101.0SA", _
  473. "Enter PNs",SmdPN & ";" & DipPN & ";" & PcbPN)
  474. if strInput="" then WScript.Quit
  475. arrInput=Split(strInput,";")
  476. dim newSmdPN,newDipPN,newPcbPN
  477. newSmdPN=UCase(Trim(arrInput(0)))
  478. newDipPN=UCase(Trim(arrInput(1)))
  479. newPcbPN=UCase(Trim(arrInput(2)))
  480. if not UCase(SmdPN & DipPN & PcbPN)=(newSmdPN & newDipPN & newPcbPN) then
  481. 'if these part numbers are new, update and write them to setup.ini
  482. SmdPN=newSmdPN
  483. DipPN=newDipPN
  484. PcbPN=newPcbPN
  485. call WriteSetup(setupfile,strBegin,strEnd,"SmdPN",SmdPN)
  486. call WriteSetup(setupfile,strBegin,strEnd,"DipPN",DipPN)
  487. call WriteSetup(setupfile,strBegin,strEnd,"PcbPN",PcbPN)
  488. end if
  489. 'open excel to generate pre-BOM
  490. dim objExcel,objWorkbook,objWorksheet
  491. set objExcel=CreateObject("Excel.Application")
  492. set objWorkbook=objExcel.Workbooks.Add
  493. set objWorksheet=objWorkbook.Sheets(1)
  494. objExcel.Visible=True
  495. 'Add header line
  496. arrLine=Array("Assembly P/N","Assembly Class","Part Number", _
  497. "Priority","Mount Type","Quantity","Location")
  498. for i=1 to UBound(arrLine)+1
  499. objWorksheet.Cells(1,i)=arrLine(i-1)
  500. next
  501. 'add each part
  502. dim row,IfExistsRed
  503. row=2
  504. IfExistsRed=false
  505. for each item in dictParts.Items
  506. objWorksheet.Cells(row,1)=SmdPN
  507. objWorksheet.Cells(row,2)="EE"
  508. objWorksheet.Cells(row,3)=item.PartNumber
  509. objWorksheet.Cells(row,4)=1
  510. objWorksheet.Cells(row,5)="S"
  511. objWorksheet.Cells(row,6)=item.Quantity
  512. objWorksheet.Cells(row,7)=item.Location
  513. if item.PNmayDip then
  514. 'if part may be Dip, mark with red
  515. IfExistsRed=true
  516. objWorksheet.Cells(row,1).Interior.ColorIndex=3
  517. objWorksheet.Cells(row,5).Interior.ColorIndex=3
  518. end if
  519. row=row+1
  520. next
  521. 'sort by part numbers
  522. dim objRange,objC1
  523. const Ascending=1,Descending=2,HeaderLineYes=1
  524. set objRange=objWorksheet.UsedRange
  525. set objC1=objExcel.Range("C1")
  526. objRange.Sort objC1,Ascending,,,,,,HeaderLineYes
  527. 'Insert two lines
  528. objWorksheet.Rows(2).Insert
  529. arrLine=Array(SmdPN,"EE",PcbPN, _
  530. 1,"S","1")
  531. for i=1 to UBound(arrLine)+1
  532. objWorksheet.Cells(2,i)=arrLine(i-1)
  533. objWorksheet.Cells(2,i).Font.ColorIndex=5
  534. next
  535. objWorksheet.Rows(2).Insert
  536. arrLine=Array(DipPN,"EE",SmdPN, _
  537. 1,"D","1")
  538. for i=1 to UBound(arrLine)+1
  539. objWorksheet.Cells(2,i)=arrLine(i-1)
  540. objWorksheet.Cells(2,i).Font.ColorIndex=5
  541. next
  542. 'auto filter
  543. objRange.EntireColumn.AutoFilter
  544. 'Auto fit
  545. objRange.EntireColumn.AutoFit()
  546. if IfExistsRed then MsgBox "pre-BOM has been generated. Please check those values marked by red."
  547. end sub
  548. 'function to read parts from excel
  549. 'strFile points to the Excel file
  550. 'HeaderLine and StartLine identify the header line and first useful line
  551. 'PartNumber,ParentPN,Quantity,Location,Level are column names
  552. function ReadExcelParts(strFile,HeaderLine,StartLine,PartNumber,ParentPN,Quantity,Location,Level)
  553. dim objExcel,objWorkbook,objWorksheet
  554. set objExcel=CreateObject("Excel.Application")
  555. set objWorkbook=objExcel.Workbooks.Open(strFile)
  556. set objWorksheet=objWorkbook.Sheets(1)
  557. dim dictParts
  558. set dictParts=CreateObject("scripting.Dictionary")
  559. 'Get column numbers to a dictionary
  560. dim dictColumn,i,item,found
  561. set dictColumn=CreateObject("scripting.Dictionary")
  562. for each item in Array(PartNumber,ParentPN,Quantity,Location,Level)
  563. found=false
  564. for i=1 to objWorkSheet.UsedRange.Columns.Count
  565. if UCase(objWorksheet.Cells(HeaderLine,i))=UCase(item) then
  566. found=true
  567. dictColumn.Add item,i
  568. exit for
  569. end if
  570. next
  571. if found=false then
  572. MsgBox "Excel BOM format check failed." & vbNewLine &_
  573. "Expect """ & item & """ on line " & HeaderLine &_
  574. " of " & strFile & "." & vbNewLine &vbNewLine &_
  575. "Solutions:" & vbNewLine &_
  576. "1.Check value of ""HeaderLine"" in setup.ini;" &_
  577. vbNewLine & "2.Check your Excel file " & strFile & ".", _
  578. vbOkOnly+vbCritical,"Error"
  579. WScript.Quit
  580. end if
  581. next
  582. 'begin to read parts
  583. dim objPart,PreviousPN        'PreviousPN refers to the last main source part number
  584. for i=StartLine to objWorkSheet.UsedRange.Rows.Count
  585. if Instr(UCase("12A"),UCase(objWorksheet.Cells(i,dictColumn.Item(Level)))) then
  586. 'if the row is useful
  587. set objPart=new part
  588. objPart.PartNumber=objWorksheet.Cells(i,dictColumn.item(PartNumber))
  589. objPart.Quantity=objWorksheet.Cells(i,dictColumn.item(Quantity))
  590. objPart.Location=objWorksheet.Cells(i,dictColumn.item(Location))
  591. objPart.strSepar=" "
  592. objPart.ParentPN=objWorksheet.Cells(i,dictColumn.item(ParentPN))
  593. objPart.boolIsSecond=(UCase(objWorksheet.Cells(i,dictColumn.item(Level)))="A")
  594. if objPart.boolIsSecond then
  595. 'if this part is a second source
  596. objPart.MainSource=PreviousPN
  597. dictParts.Add objPart.PartNumber & "-" & objPart.MainSource,objPart
  598. else
  599. 'if this part is a main source
  600. dictParts.Add objPart.PartNumber,objPart
  601. PreviousPN=objPart.PartNumber
  602. end if
  603. end if
  604. next
  605. objExcel.Quit
  606. Set ReadExcelParts=dictParts
  607. end function
  608. 'function to compare two part dictionary specified by dictFirstParts,dictSecondParts
  609. 'returns an array, which:
  610. 'array(0):a string including part numbers only in the first dictionary
  611. 'array(1):a string including part numbers only in the second dictionary
  612. 'array(2):a string including mismatched locations
  613. function CompareDicts(dictFirstParts,dictSecondParts)
  614. dim arrCompare,dictCompared,item
  615. arrCompare=Array("","","")
  616. 'based on dictFirstParts to compare dictSecondParts
  617. dim arrLack
  618. for each item in dictFirstParts.Keys
  619. if dictSecondParts.Exists(item) then
  620. 'if dictSecondParts contains the part number with the same IsSecond property
  621. if not dictFirstParts.Item(item).boolIsSecond then
  622. 'if this part is not second source, for there is no need to compare 2nd source
  623. arrLack=CompareLocation( _
  624. Split(dictFirstParts.Item(item).Location, _
  625. dictFirstParts.Item(item).strSepar), _
  626. Split(dictSecondParts.Item(item).Location, _
  627. dictSecondParts.Item(item).strSepar))
  628. if not Join(arrLack)=" " then
  629. 'if mismatch is found
  630. arrCompare(2)=arrCompare(2) & "Part Number:" & dictFirstParts.Item(item).PartNumber & vbNewLine &_
  631. "1st  Quantity:" & dictFirstParts.Item(item).Quantity & vbNewLine &_
  632. "1st  Location:" & dictFirstParts.Item(item).Location & vbNewLine &_
  633. "2nd  Quantity:" & dictSecondParts.Item(item).Quantity & vbNewLine &_
  634. "2nd  Location:" & dictSecondParts.Item(item).Location & vbNewLine &_
  635. "Is 2nd Source:" & dictFirstParts.Item(item).boolIsSecond & vbNewLine
  636. if not dictFirstParts.Item(item).ParentPN="Unknown" then
  637. arrCompare(2)=arrCompare(2) & "Parent PN:" & dictFirstParts.Item(item).ParentPN & vbNewLine
  638. elseif not dictSecondParts.Item(item).ParentPN="Unknown" then
  639. arrCompare(2)=arrCompare(2) & "Parent PN:" & dictSecondParts.Item(item).ParentPN & vbNewLine
  640. else
  641. arrCompare(2)=arrCompare(2) & "Parent PN:" & dictFirstParts.Item(item).ParentPN & vbNewLine
  642. end if
  643. if not arrLack(0)="" then
  644. arrCompare(2)=arrCompare(2) & "Only in 1st:" & arrLack(0) & vbNewLine
  645. end if
  646. if not arrLack(1)="" then
  647. arrCompare(2)=arrCompare(2) & "Only in 2nd:" & arrLack(1) & vbNewLine
  648. end if
  649. arrCompare(2)=arrCompare(2) & vbNewLine
  650. end if
  651. end if
  652. else
  653. 'if dictSecondParts doesn't contain part number with the same IsSecond property
  654. arrCompare(0)=arrCompare(0) & "Part Number:" & dictFirstParts.Item(item).PartNumber & vbNewLine &_
  655. "Quantity:" & dictFirstParts.Item(item).Quantity & vbNewLine &_
  656. "Location:" & dictFirstParts.Item(item).Location & vbNewLine &_
  657. "Parent PN:" & dictFirstParts.Item(item).ParentPN & vbNewLine &_
  658. "Is 2nd Source:" & dictFirstParts.Item(item).boolIsSecond & vbNewLine
  659. if dictFirstParts.Item(item).boolIsSecond then
  660. arrCompare(0)=arrCompare(0) & "Main Source:" &_
  661. dictFirstParts.Item(item).MainSource & vbNewLine
  662. end if
  663. arrCompare(0)=arrCompare(0) & vbNewLine
  664. end if
  665. next
  666. 'based on dictFirstParts to compare dictSecondParts
  667. for each item in dictSecondParts.Keys
  668. if not dictFirstParts.Exists(item) then
  669. 'if dictFirstParts doesn't contain part number with the same IsSecond property
  670. arrCompare(1)=arrCompare(1) & "Part Number:" & dictSecondParts.Item(item).PartNumber & vbNewLine &_
  671. "Quantity:" & dictSecondParts.Item(item).Quantity & vbNewLine &_
  672. "Location:" & dictSecondParts.Item(item).Location & vbNewLine &_
  673. "Parent PN:" & dictSecondParts.Item(item).ParentPN & vbNewLine &_
  674. "Is 2nd Source:" & dictSecondParts.Item(item).boolIsSecond & vbNewLine
  675. if dictSecondParts.Item(item).boolIsSecond then
  676. arrCompare(1)=arrCompare(1) & "Main Source:" &_
  677. dictSecondParts.Item(item).MainSource & vbNewLine
  678. end if
  679. arrCompare(1)=arrCompare(1) & vbNewLine
  680. end if
  681. next
  682. CompareDicts=arrCompare
  683. end function
  684. 'function to check the difference between two arrays
  685. 'return an array to hold the results, which:
  686. 'array(0):only in the first array
  687. 'array(1):only in the second array
  688. function CompareLocation(arrayA,arrayB)
  689. dim arrLack,strA,strB,item
  690. arrLack=Array("","")
  691. strA="," & Join(arrayA,",") & ","
  692. strB="," & Join(arrayB,",") & ","
  693. for each item in arrayA
  694. if Instr(strB,item)=0 then arrLack(0)=arrLack(0) & "," & item
  695. next
  696. for each item in arrayB
  697. if Instr(strA,item)=0 then arrLack(1)=arrLack(1) & "," & item
  698. next
  699. arrLack(0)=Mid(arrLack(0),2)
  700. arrLack(1)=Mid(arrLack(1),2)
  701. CompareLocation=arrLack
  702. end function
  703. '****************class area***************
  704. class part
  705. private PN,Qty,Loc    'PartNumber,Quantity,IsPOP,Location
  706. private boolNormalPN    'If Part Number is normal
  707. public strSepar 'separator to separate locations
  708. public boolIsSecond 'if this pard is 2nd source
  709. public ParentPN 'parent part number
  710. public MainSource 'Main source when it's 2nd source
  711. 'Part Number property
  712. property let PartNumber(strPartNumber)
  713. if strPartNumber="" then
  714. Err.Raise 101,"BomKit check error","Detected empty part number " & strPartNumber
  715. end if
  716. PN=strPartNumber
  717. call CheckPN()
  718. end property
  719. property get PartNumber()
  720. PartNumber=PN
  721. end property
  722. 'Quantity property
  723. property let Quantity(intQuantity)
  724. Qty=CInt(intQuantity)
  725. if Qty<0 then
  726. Err.Raise 102,"BomKit check error","Negative Quantity " & Qty
  727. end if
  728. end property
  729. property get Quantity()
  730. Quantity=Qty
  731. end property
  732. 'Location property
  733. property let Location(strLocation)
  734. Loc=strLocation
  735. end property
  736. property get Location()
  737. Location=Loc
  738. end property
  739. 'sub to check if part number is 253/354 type
  740. private sub CheckPN()
  741. dim re
  742. set re=new RegExp
  743. re.Pattern="^(\w{2}\.\w{5}\.\w{3}|\w{3}\.\w{5}\.\w{4})$"
  744. if re.Test(PN) then
  745. boolNormalPN=true
  746. else
  747. boolNormalPN=false
  748. end if
  749. end sub
  750. 'class initialize event
  751. private sub Class_Initialize
  752. boolNormalPN=false
  753. PN=""
  754. Qty=0
  755. Loc=""
  756. strSepar=","
  757. boolIsSecond=false
  758. ParentPN="Unknown"
  759. MainSource="N/A"
  760. end sub
  761. 'function to check if Quantity is equal to the real length
  762. public function CheckQty()
  763. CheckQty=(Qty=UBound(Split(Loc,strSepar))+1)
  764. end function
  765. 'sub to correct wrong quantity
  766. public sub CorrectQty()
  767. Qty=RealQty()
  768. end sub
  769. 'function to return real quantity
  770. public function RealQty()
  771. RealQty=UBound(Split(Loc,strSepar))+1
  772. end function
  773. 'function to show whether pn is normal
  774. public function IsNormalPN()
  775. IsNormalPN=boolNormalPN
  776. end function
  777. 'function to check if part number is ZZ
  778. public function IsBadPN()
  779. IsBadPN=false
  780. if Left(PN,2)="ZZ" then IsBadPN=true
  781. dim re
  782. set re=new RegExp
  783. re.Pattern="^\s*$"
  784. if re.Test(PN) then
  785. IsBadPN=true
  786. end if
  787. end function
  788. 'function to check if part number may be dip
  789. public function PNmayDip()
  790. dim arrPN
  791. if boolNormalPN then
  792. arrPN=Split(PN,".")
  793. PNmayDip=(20<=CInt(arrPN(0)) and CInt(arrPN(0))<=60)
  794. else
  795. PNmayDip=true
  796. end if
  797. end function
  798. end class
复制代码
看得多说得多,远比不上写得多。

返回列表