Created
May 8, 2012 18:50
-
-
Save mockmyberet/2638448 to your computer and use it in GitHub Desktop.
New function to replace open file dialog by building an HTA
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Function ChooseFile( ) | |
| Dim objFSO, objShell, objTempFolder, strTempFileName, strFullTempFileName, objOpenFile, objTextFile, strTempTextFileName | |
| Const TemporaryFolder = 2 | |
| Const ForReading = 1 | |
| strTempFileName = "OpenFile.hta" | |
| strTempTextFileName = "OpenFile.txt" | |
| Set objFSO= CreateObject("Scripting.FileSystemObject") | |
| Set objTempFolder = objFSO.GetSpecialFolder(TemporaryFolder) | |
| strFullTempFileName=objTempFolder.Path & "\" & strTempFileName | |
| Set objOpenFile = objFSO.CreateTextFile(strFullTempFileName,True) | |
| objOpenFile.writeline("<html><head><meta http-equiv=""Content-Type"" content=""text/html; charset=windows-1252"">") | |
| objOpenFile.writeline("<title>Open File</title>") | |
| objOpenFile.writeline("<script language=""vbscript"">") | |
| objOpenFile.writeline("Sub Window_Onload") | |
| objOpenFile.writeline("FileName.click") | |
| objOpenFile.writeline("WriteFile FileName.value") | |
| objOpenFile.writeline("Self.Close()") | |
| objOpenFile.writeline("End Sub") | |
| objOpenFile.writeline("Sub WriteFile(strFileName)") | |
| objOpenFile.writeline("Dim objFSO, objTempFolder, strTempFileName, strFullTempFileName, objOpenFile") | |
| objOpenFile.writeline("Const TemporaryFolder = 2") | |
| objOpenFile.writeline("strTempFileName = ""OpenFile.txt""") | |
| objOpenFile.writeline("Set objFSO=CreateObject(""Scripting.FileSystemObject"")") | |
| objOpenFile.writeline("Set objTempFolder = objFSO.GetSpecialFolder(TemporaryFolder)") | |
| objOpenFile.writeline("strFullTempFileName=objTempFolder.Path & ""\"" & strTempFileName") | |
| objOpenFile.writeline("Set objOpenFile = objFSO.CreateTextFile(strFullTempFileName,True)") | |
| objOpenFile.writeline("objOpenFile.writeline(strFileName)") | |
| objOpenFile.writeline("objOpenFile.Close") | |
| objOpenFile.writeline("Set objFSO=Nothing") | |
| objOpenFile.writeline("Set objTempFolder=Nothing") | |
| objOpenFile.writeline("Set objSleepFile=Nothing") | |
| objOpenFile.writeline("Set objShell=Nothing") | |
| objOpenFile.writeline("End Sub") | |
| objOpenFile.writeline("</script>") | |
| objOpenFile.writeline("<hta:application applicationname=""Open File"" border=""dialog"" borderstyle=""normal"" caption=""Open File"" contextmenu=""no"" maximizebutton=""no"" minimizebutton=""no"" navigable=""no"" scroll=""no"" selection=""no"" showintaskbar=""no"" singleinstance=""yes"" sysmenu=""no"" version=""1.0"" windowstate=""minimize"">") | |
| objOpenFile.writeline("</head>") | |
| objOpenFile.writeline("<body>") | |
| objOpenFile.writeline("<input Application=""True"" type=""file"" id=""FileName"" />") | |
| objOpenFile.writeline("</body>") | |
| objOpenFile.writeline("</html>") | |
| objOpenFile.Close | |
| Set objShell = CreateObject("WScript.Shell") | |
| objShell.Run "mshta.exe " & strFullTempFileName,0,True | |
| objFSO.DeleteFile strFullTempFileName, True | |
| Set objShell=Nothing | |
| Set objOpenFile=Nothing | |
| strFullTempFileName = objTempFolder.Path & "\" & strTempTextFileName | |
| Set objTextFile=objFSO.OpenTextFile(strFullTempFileName, ForReading) | |
| ChooseFile = objTextFile.ReadLine | |
| objTextFile.Close | |
| objFSO.DeleteFile strFullTempFileName, True | |
| Set objTextFile=Nothing | |
| Set objFSO=Nothing | |
| Set objTempFolder=Nothing | |
| End Function |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment