Option Explicit
'---------------------------------------------------------------------------------------
' Module : basGetExe
' DateTime : 05/12/04 19:18
' Author : Ivan F Moala
' Purpose : Gets the path to the Executable file as defined
' : in the associated files Extension
'---------------------------------------------------------------------------------------
Private Declare Function FindExecutable _
Lib "shell32.dll" _
Alias "FindExecutableA" ( _
ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal lpResult As String) _
As Long
Private Const MAX_FILENAME_LEN = 260
'//---------------------------------------------------------------------------------------
'// Project : VBAProject
'// DateTime : 05/12/04 21:07
'// Author : Ivan F Moala
'// Site : http://www.xcelfiles.com
'// Purpose : Gets Executable file path
'// In : File extension OR Path to File
'// Out/Return: Path to executable
'---------------------------------------------------------------------------------------
'
Function fGetExePath(strFileExt_OrPathToFile As String) As String
'// NB: I included Error lines JustInCase !
Dim I As Integer, strBuffer As String
Dim strFn As String, strExt As String
Dim handle As Integer
Dim Pos As Long
Dim vaFile As Variant
Pos = InStr(1, strFileExt_OrPathToFile, ".")
If Pos = 0 Then
strExt = strFileExt_OrPathToFile
Else
strExt = Right(strFileExt_OrPathToFile, Len(strFileExt_OrPathToFile) - Pos)
End If
strFn = fTmpFolderLocation & "\Tmp." & strExt
handle = FreeFile
On Error GoTo Errh
'// Open a new File
1 Open strFn For Output As #handle
'// Write to File
2 Print #handle, vbNullString
'// Close the File
3 Close #handle
'// Create a buffer
4 strBuffer = String(MAX_FILENAME_LEN, 32)
'// Retrieve the name and handle of the executable, associated with this file
5 I = FindExecutable(strFn, vbNullString, strBuffer) '
6 If I > 32 Then
'// Found!
7 fGetExePath = Left(strBuffer, InStr(strBuffer, Chr$(0)) - 1)
Else
'// NOT Found - so search for it!
8 vaFile = Application.GetOpenFilename(strExt & " Exe (*.exe),*.exe")
9 If TypeName(vaFile) = "Boolean" Then
10 fGetExePath = vbNullString
Else
11 fGetExePath = vaFile
End If
End If
12 Kill strFn
Exit Function
Errh:
fGetExePath = "An Error occured! " & " @Line " & Erl() & vbCrLf & _
"ErrNumber " & Err.Number & ":=" & Err.Description
End Function
Function fTmpFolderLocation() As String
'//---------------------------------------------------------------------------------------
'// Project : VBAProject
'// DateTime : 05/12/04 21:19
'// Author : Ivan F Moala
'// Site : http://www.xcelfiles.com
'// Purpose : Gets a Temp directory location to work in
'// In : None
'// Out/Return: Temp Directory either Tmp or default Application path
'---------------------------------------------------------------------------------------
Dim Tmp As String, Fso As Object, TFolder As Object
'// 1st Try getting via Environ
Tmp = Environ("Tmp")
If Len(Tmp) <> 0 Then GoTo Xit
'// NoGo so try FSO
Set Fso = CreateObject("Scripting.FileSystemObject")
Set TFolder = Fso.getSpecialFolder(2)
Tmp = TFolder.Path
If Len(Tmp) = 0 Then
'// Still No Go so use This workbooks path
fTmpFolderLocation = ThisWorkbook.Path
End If
Set Fso = Nothing
Set TFolder = Nothing
Exit Function
Xit:
fTmpFolderLocation = Tmp
End Function