Search This Blog

Monday, March 9, 2009

Open folder to location of a file

I cannot seem to remember this even though I wrote code at least twice to do it!

In dlgUpgrade From in DRC

'WIN32 API
Private Declare Function SetActiveWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


'Add functions
Public Function StartDoc(ByVal fileName As String, Optional CommandLine As String = "") As Long
StartDoc = ShellExecute(0&, "Open", fileName, CommandLine, vbNullString, 1)
End Function
Private Function GetParentDir(ByVal myFile As String, Optional RemoveSeparator As Boolean = True, Optional IgnoreDirValidation As Boolean = False) As String
On Error Resume Next
Dim i As Long, j As Integer
If RemoveSeparator = True Then
j = 1
Else
j = 0
End If
If IgnoreDirValidation = True Then
i = InStr(1, StrReverse(myFile), "\")
If i = 0 Then
GetParentDir = ""
Else
GetParentDir = StrReverse(Mid$(StrReverse(myFile), i + j))
End If
Else
If Dir$(myFile) = "" Then
GetParentDir = ""
Else
i = InStr(1, StrReverse(myFile), "\")
If i = 0 Then
GetParentDir = ""
Else
GetParentDir = StrReverse(Mid$(StrReverse(myFile), i + j))
End If
End If
End If
End Function

Private Function getFileName(filePath As String, Optional separator As String = "\", Optional removeExtension As Boolean = False) As String
Dim tmp As String
tmp = Mid$(filePath, InStrRev(filePath, separator) + 1)
If tmp = filePath Then
getFileName = ""
Else
If removeExtension Then
If InStrRev(tmp, ".") > 0 Then
getFileName = Left$(tmp, InStrRev(tmp, ".") - 1)
Else
getFileName = tmp
End If
Else
getFileName = tmp
End If
End If
End Function


'Call to OpenFileFolder
Private Sub OpenFileFolder(filePath As String)
Dim i As Long, j As Long, fileName As String
If isFileExist(filePath) Then
i = StartDoc("explorer.exe ", GetParentDir(filePath))
j = SetActiveWindow(i)
Sleep 1000 '<< 1 second
DoEvents

fileName = getFileName(filePath)
For i = 1 To Len(fileName)
SendKeys Mid$(fileName, i, 1)
DoEvents
Next i
End If
End Sub

No comments: