jcunews

ExcelHelper.hta

Jun 13th, 2019
203
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. <hta:application applicationname=excelhelper border=dialog innerborder=no
  2.  maximizebutton=no scroll=no singleinstance=yes />
  3. <title></title>
  4. <style>
  5. html {
  6.   background-color: buttonface;
  7. }
  8. label {
  9.   display:inline-block;
  10.   width: 12ex;
  11. }
  12. #inpSerialNumber {
  13.   margin-top: .5em;
  14. }
  15. #btnProcess {
  16.   margin-left: 12ex;
  17. }
  18. </style>
  19.  
  20. <label for=inpProductCode>Product Code:</label>
  21. <input id=inpProductCode value=test required /><br />
  22. <label for=inpSerialNumber>Serial Number:</label>
  23. <input id=inpSerialNumber /><br />
  24. <br />
  25. <input type=button id=btnProcess value=Process disabled />
  26. <p id=msg>Retrieving Excel application instance...</p>
  27.  
  28.  
  29. <!-- ===== Script Initialization ===== -->
  30. <script language=vbscript>
  31. dim objExcel
  32. Const ForAppending = 8
  33. Set objFSO = CreateObject("Scripting.FileSystemObject")
  34. Set objShell = CreateObject("WScript.Shell")
  35.  
  36. InputFile  = "\\oldenzaal06\common\Ebike\EPACLabel\models.csv"
  37. LabelFile  = "\\oldenzaal06\common\Ebike\EPACLabel\EPAClabel.btw"
  38. LogFile    = "\\oldenzaal06\common\Ebike\EPACLabel\log\"
  39. OutputFile = objShell.ExpandEnvironmentStrings("%UserProfile%") & _
  40.             "\Desktop\EPACLabel.txt"
  41.  
  42. wid = 300
  43. hei = 200
  44. resizeto wid, hei
  45. moveto (screen.width-wid)/2, (screen.height-hei)/2
  46.  
  47. appTitle = "Excel Helper"
  48. document.title = appTitle
  49. </script>
  50.  
  51. <!-- ===== Task Initialization ===== -->
  52. <script for=window event=onload language=vbscript>
  53. On Error Resume Next
  54.  
  55. set objExcel = nothing
  56. Set objExcel = CreateObject("Excel.Application")
  57. if objExcel is nothing then
  58.  msgbox "Failed to retrieve Excel application instance." &vbcrlf& _
  59.    err.description, vbCritical, appTitle
  60.  close
  61. end if
  62.  
  63. msg.innerText = "Opening Excel document..."
  64. set objWorkbook = nothing
  65. if ucase(right(InputFile, 4)) = ".CSV" then
  66.  objExcel.Workbooks.OpenText(InputFile)
  67. else
  68.  objExcel.Workbooks.Open(InputFile)
  69. end if
  70. if objExcel.ActiveWorkbook is nothing then
  71.  msgbox "Failed to open Excel document." &vbcrlf& err.description, _
  72.    vbCritical, appTitle
  73.  close
  74. end if
  75.  
  76. btnProcess.disabled = false
  77. msg.innerText = "Ready for processing."
  78. </script>
  79.  
  80.  
  81. <!-- ===== Processing ===== -->
  82. <script for=btnProcess event=onclick language=vbscript>
  83. On Error Resume Next
  84.  
  85. ProductCode = trim(inpProductCode.value)
  86.  
  87. If ProductCode <> "" Then
  88.  SerialNumber = trim(inpSerialNumber.value)
  89.  intRow = 2
  90.  Do until objExcel.Cells(intRow, 1).Value2 = ""
  91.    ProductRange = objExcel.Cells(intRow, 1).Value
  92.    sType = objExcel.Cells(intRow, 2).Value2
  93.    sColor = objExcel.Cells(intRow, 3).Value2
  94.  
  95.    'If user entered value matches (row 2 matches value before comma in row 1)
  96.  
  97.    sResult = InStr(1, ProductRange, ProductCode, 1)
  98.    If sResult <> 0 Then
  99.      aYear = Year(Date) 'The year of the computer
  100.      oFile = empty
  101.      Set oFile = nothing
  102.      Set oFile = objFSO.CreateTextFile(OutputFile, true)
  103.      if not (oFile is nothing) then
  104.        oFile.WriteLine sType &","& sColor &","& SerialNumber &","& aYear
  105.        oFile.Close
  106.        e = objShell.Run("cmd /c ""%ProgramFiles(x86)%\Bartender\Bartend.exe"" /f=""" & _
  107.          LabelFile & """ /p /d=""" & OutputFile & """", 0, true)
  108.        if e = 0 then
  109.          msgbox "Input has been processed.", vbInformation, appTitle
  110.        else
  111.          msgbox "Failed to execute application.", vbCritical, appTitle
  112.        end if
  113.      else
  114.        msgbox "Failed to create " & OutputFile & " file." &vbcrlf& _
  115.          err.description, vbCritical, appTitle
  116.      end if
  117.      exit do
  118.    End If
  119.    intRow = intRow + 1
  120.  Loop
  121.  if aYear = empty then
  122.    msgbox "Product code is not found." &vbcrlf&vbcrlf& _
  123.      "Note: Product code is case sensitive.", vbCritical, appTitle
  124.  end if
  125. Else
  126.  msgbox "Please enter a product code (case sensitive).", vbCritical, appTitle
  127. End If
  128. </script>
  129.  
  130.  
  131. <!-- ===== Clean up ===== -->
  132. <script for=window event=onbeforeunload language=vbscript>
  133. if not (objExcel is nothing) then objExcel.Quit
  134. </script>
RAW Paste Data