multiple file selects button in an hta

bn2hunt · Nov 8, 2007

I am trying to write an hta that will allow a end user to select multiple pdf documents and then merge them into one document.

I can do it if I let the user select a single file at a time but the multiple file selects is cuasing me a headache. Any suggestions.

Here is what I have so far

Code:

<html>

<head>

<title>Append PDF files</title>

<HTA:APPLICATION
     ID="appendpdf"
     APPLICATIONNAME="appendpdf"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="maximize"
>
</head>

<style>
BODY
{
   background-color: buttonface;
   font-family: Helvetica;
   font-size: 8pt;
   margin-top: 10px;
   margin-left: 20px;
   margin-right: 20px;
   margin-bottom: 10px;
}
.button
{
   font-family: Helvetica;
   font-size: 8pt;
   width: 130px;
}
textarea
{
   font-family: arial;
   font-size: 8pt;
}
select
{
   font-family: arial;
   font-size: 8pt;
   width: 800px;
   margin-left: 0px;
}
td
{
   font-family: arial;
   font-size: 10pt;
}
</style>

<body>

&nbsp;<br>

<table border width="100%">
    <tr>
        <td>

<SCRIPT LANGUAGE="VBScript">
	Set ws = CreateObject("WScript.Shell")
   	Set fs = CreateObject("Scripting.FileSystemObject")
	Set doc = CreateObject("CDIntfEx.Document")
	
Sub window_onload()
	argpassed = ws.ExpandEnvironmentStrings ("%ASEEXEARGS%")
	If argpassed <> "" Then 
		MsgBox argpassed
		firstfile.value = argpassed
	Else
		MsgBox "argpassed failed"
	End If
	h = 230
	w = 600
	sxTop = window.screen.height/2 -(h/2)
	sxLeft = window.screen.width/2  -(w/2)

	self.MoveTo sxLeft, sxTop
	self.ResizeTo w, h

End Sub
Sub TestSub
	If firstfile.value = "" Then 
		MsgBox "must select the first file to append"
		Exit Sub
	Else
		doc.open firstfile.value
	End If
	
	If secfile.value = "" Then
		MsgBox "only one file selected, please select a second file"
		Exit Sub
	Else
		doc.append secfile.value
		If thirdfile.value = "" Then
			lit1 = ws.popup("I am going to append the following file(s)" & vbcr & firstfile.value & vbcr & secfile.value)
		Else	
			DOC.APPEND thirdfile.value
			If forthfile.value = "" Then
				lit1 = ws.popup("I am going to append the following file(s)" & vbcr & firstfile.value & vbcr & secfile.value & vbcr & thirdfile.value)
			Else	
				DOC.APPEND forthfile.value
     		End If
		End If
	End If
		lit1 = "Enter a new filename for the combined files" & vbcr
		lit1 = lit1 & "It will be saved to your desktop"
	filename = InputBox(lit1,"Enter a filename","combined.pdf")
	If LCase(Right(filename,4)) <> ".pdf" Then filename = filename & ".pdf"
	doc.Save ws.ExpandEnvironmentStrings("%ALLUSERSPROFILE%") & "\desktop\"  & filename

	End Sub
      
	        
</SCRIPT>
<body>
   <table>
		<tr>
			<td>First File Name </td>
			<td><INPUT type="file" size="40" name="firstfile" </td>
		</tr>
		<tr>
			<td >Second File Name</td>
			<td><INPUT size = 40 type="file" name="secfile"</td>
		</tr>
		<tr>
			<td >Third File Name</td>
			<td><INPUT size = 40 type="file" name="thirdfile"</td>
		</tr>
		<tr>
			<td >Forth File Name</td>
			<td><INPUT size = 40 type="file" name="forthfile"</td>
		</tr>		
		<TR>
			<TD><INPUT TYPE=BUTTON NAME="APPEND" Value = "Append PDF Documents" ONCLICK="testsub"</TD>
			<td><input type=button name="close" value = "Close" onclick="window.close()"</td>
		</TR>
   </table>


</body>
</html>

bn2hunt

"Born to hunt forced to work

Swi · Nov 9, 2007

This should give you a start. This take multiple Publisher files and saves them as 300dpi JPG.

Code:

<head>
<title>Save Publisher File As JPG</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Save Publisher File As JPG"
     SCROLL="Auto"
     SINGLEINSTANCE="Yes"
     CAPTION="No"
     WINDOWSTATE="Normal">
<script language="VBScript">
    Option Explicit
    Dim ocomdlg
    Dim objPublisher
    Dim filespec
    Dim objFSO
    Dim objVoice
    Dim j
    Dim i
    Dim TimerID
    Dim strFiles
    Dim arrTemp
    Dim sFileNames
    Dim errRtn
    Dim strPath
    Const iWIDTH = 900
    Const iHEIGHT = 150
    Const cdlOFNAllowMultiselect = 512
    Const pbDoNotSaveChanges = 3
    Const pbPictureResolutionCommercialPrint_300dpi = 3

    Sub ValidateScreenInfo
      Set objVoice = CreateObject("SAPI.SpVoice")
      Set objVoice.Voice = objVoice.GetVoices("Name=Microsoft Sam").Item(0)
      If Trim(document.frmForm.InputFile.value) = "" Then
        objVoice.Speak "You must choose an input file!"
        document.frmForm.browse_button.focus()
        Set objVoice = Nothing
        Exit Sub
      End If
      Set objVoice = Nothing
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objPublisher = CreateObject("Publisher.Application")
      TimerID = window.setInterval("Looper",1)
    End Sub

    Sub ExitHTA
      self.close()
    End Sub

    Sub Window_OnLoad()
      Window.ResizeTo iWIDTH, iHEIGHT
      Window.MoveTo (Screen.availWidth-iWIDTH)/2,_
      (Screen.availHeight-iHEIGHT)/2
    End Sub

    Sub Browse
      document.frmForm.InputFile.Value = ""
      set ocomdlg=createobject("userAccounts.commonDialog")
        with ocomdlg
          .flags = cdlOFNAllowMultiselect
          .filter="Publisher Files|*.pub|All Files|*.*"
          .filterIndex = 3
          errRtn = .showopen()
        end with
        strPath = ""
        strFiles = ""
        If errRtn = False Then
            Msgbox "No file selected!"
            Exit Sub
        Else
          If InStr(ocomdlg.FileName, "\ ") Then
            arrTemp = Split(ocomdlg.FileName, " ")
            strPath = arrTemp(0)
            For i = 1 To UBound(arrTemp)
              strFiles = strFiles & GetLongName(strPath & arrTemp(i)) & vbNullChar
            Next
          Else
            strPath = Mid(ocomdlg.FileName,1, InStrRev(ocomdlg.FileName, "\"))
            strFiles = Mid(ocomdlg.FileName, InStrRev(ocomdlg.FileName, "\") + 1)
          End If
        End If
      sFileNames = Split(Left(strFiles,Len(strFiles) - 1), vbNullChar)
      If UBound(sFileNames) > 0 Then
	document.frmForm.InputFile.Value = sFileNames(0)
      Else
        ReDim sFilesNames(0)
        sFileNames(0) = strFiles
        document.frmForm.InputFile.Value = sFileNames(0)
      End If
      j = 0
    End Sub

    Function GetLongName(strFileName)
      Dim objShell, objFSO2, objFile, objFolder, objItem
      Set objShell = CreateObject("Shell.Application")
      Set objFSO2 = CreateObject("Scripting.FileSystemObject")
      Set objFile = objFSO2.GetFile(strFileName)
      Set objFolder = objShell.NameSpace(objFile.ParentFolder.Path)
      Set objItem = objFolder.ParseName(objFile.Name)
      GetLongName = Replace(objItem.Path, objFile.ParentFolder.Path & "\", "")
      Set objShell = Nothing
      Set objFSO2 = Nothing
      Set objFile = Nothing
      Set objFolder = Nothing
      Set objItem = Nothing
    End Function

    Sub Looper
      document.frmForm.InputFile.Value = sFileNames(j)
      DataArea.InnerHTML = "<b><font color='red' face='Arial'>Converting File: " & j + 1 & " of " & Ubound(sFileNames) + 1 & "</font></b>"
      With objPublisher
        .Open sFileNames(j),True,False,pbDoNotSaveChanges
        .ActiveDocument.Pages(1).SaveAsPicture Replace(Ucase(sFileNames(j)),".PUB",".JPG"),pbPictureResolutionCommercialPrint_300dpi
        .ActiveDocument.Close
      End With
      If j = Ubound(sFileNames) Then
        window.clearInterval(TimerID)
        objPublisher.Quit
        Set objFSO = Nothing
        Set objPublisher = Nothing
        Msgbox "Program Complete!"
        DataArea.InnerHTML = ""
        Exit Sub
      End If
      j = j + 1
    End Sub

</script>
</head>
<body STYLE="font:14 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=1, StartColorStr='#000000', EndColorStr='#0000FF')">
<form id=frmForm name=frmForm>
Input File: <input type="text" style="margin-left: 24px" name="InputFile" size="100" maxLength="255">
<input type="button" value="..." name="browse_button" onClick="Browse"><p>
<input type="button" style="margin-left: 100px" value="Run Script" name="run_button" onClick="ValidateScreenInfo">
<input type="button" style="margin-left: 450px" value="Exit Script" name="exit_button" onClick="ExitHTA"><p>
</form>
<center><span id="DataArea"></span></center>
</body>

Swi

bn2hunt · Nov 11, 2007

Thanks Swi, the only problem that I found is that useraccounts.commondialog doesn't exist in vista and unfortunalty I need to code for vista a well.

One thing that I thought might work if possible would be to have a textarea that the users could drop a file into.
So far I havn't found much information on that but I will keep looking.

bn2hunt

"Born to hunt forced to work

Swi · Nov 11, 2007

I did not know that about Vista although I have used it little to none at all. Good to know. Thanks.

Swi

bn2hunt · Nov 14, 2007

I ended up packaging the safrcdlg.dll file into my hta executable and used the fileopen option with that. I still have been unable to find something that is built into vista.

bn2hunt

"Born to hunt forced to work

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

multiple file selects button in an hta

bn2hunt

MIS

Swi

Programmer

bn2hunt

MIS

Swi

Programmer

bn2hunt

MIS

Similar threads

Part and Inventory Search

Sponsor