Opens any file/document in its associated application. Provided the extension is registered in syst
Opens any file/document in its associated application. Provided the extension is registered in system registry.
API Declarations
Private Const REG_NONE As Long = 0
Private Const REG_SZ As Long = 1
Private Const REG_EXPAND_SZ As Long = 2
Private Const REG_BINARY As Long = 3
Private Const REG_DWORD As Long = 4
Private Const ERROR_SUCCESS As Long = 0
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_NO_MORE_ITEMS As Long = 259
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Lon
Rate Opens any file/document in its associated application. Provided the extension is registered in syst
(1(1 Vote))
' Open the specified file with its associated application
' Return True if the file was open successfully
' False if its extension is not registered
'
'Example: OpenFile "C:\My Documents\MyDoc.doc"
Dim lExtension As String
Dim lType As String, lCommandLine As String
Dim i As Integer
OpenFile = False
' We identify the file extension
lExtension = "." + GetFileExtension(pFileName)
If Len(lExtension) > 1 Then
' If pFileName contains at least one space, it's a long filename,
' we add " characters
If InStr(1, pFileName, " ") <> 0 Then
pFileName = """" + pFileName + """"
End If
' Get the corresponding file type in the registry
lType = regQuery_A_Key(HKEY_CLASSES_ROOT, lExtension, "")
If lType = "" Then
' Unknown type
Exit Function
End If
' Get the corresponding command line
lCommandLine = regQuery_A_Key(HKEY_CLASSES_ROOT, _
lType + "\shell\open\command", "")
' MsgBox lCommandLine
Dim sr As Boolean
sr = StringReplace(pFileName, """", "")
If lCommandLine = "" Then
' No application can open this file type
MsgBox "No application can open this file type", vbCritical, "Error"
Exit Function
End If
' Replace %1 with pFileName in lCommandLine
' Adnan commented following If - End if block
If Not StringReplace(lCommandLine, "%1", _
pFileName) Then
' Add the file name at the end of the command line
lCommandLine = lCommandLine + " " + pFileName
End If
Call Shell(lCommandLine, vbMaximizedFocus)
OpenFile = True
End If
End Function
Public Function StringReplace(pString1 As String, _
pString2 As String, pString3 As String) As Boolean
'Replace all the occurences of pString2 in pString1 by pString3
Dim i As Integer
Dim lString As String
StringReplace = False
lString = pString1
i = InStr(1, lString, pString2)
While i <> 0
StringReplace = True
If i + Len(pString2) <= Len(lString) Then
lString = Left(lString, i - 1) + pString3 + _
Right(lString, Len(lString) - i - Len(pString2) + 1)
Else
lString = Left(lString, i - 1) + pString3
End If
i = InStr(1, lString, pString2)
Wend
pString1 = lString
End Function
Public Function regQuery_A_Key(ByVal hKey As Long, _
ByVal sRegKeyPath As String, _
ByVal sRegSubKey As String) As Variant
' --------------------------------------------------------------
' Written by Kenneth Ives [email protected]
'
' Important: If you treat all key data strings as being
' case sensitive, you should never have a problem.
' Always backup your registry files (System.dat
' and User.dat) before performing any type of
' modifications
'
' Description: Function for querying a sub key value.
'
' Parameters:
' hKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
' HKEY_lOCAL_MACHINE, HKEY_USERS, etc
' sRegKeyPath - is name of the key path you wish to traverse.
' sRegSubKey - is the name of the key which will be queryed.
'
' Syntax:
' sKeyQuery = regQuery_A_Key(HKEY_CURRENT_USER, _
' "Software\AAA-Registry Test\Products", _
"StringTestData")
'
' Returns the key value of "StringTestData"
' --------------------------------------------------------------
' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
Dim iPos As Integer
Dim lKeyHandle As Long
Dim lRet As Long
Dim lDataType As Long
Dim lBufferSize As Long
Dim lBuffer As Long
Dim sBuffer As String
Dim arBuffer() As Byte
' --------------------------------------------------------------
' Initialize variables
' --------------------------------------------------------------
lKeyHandle = 0
lBufferSize = 0
' --------------------------------------------------------------
' Query the key path
' --------------------------------------------------------------
lRet = RegOpenKey(hKey, sRegKeyPath, lKeyHandle)
' --------------------------------------------------------------
' If no key handle was found then there is no key. Leave here.
' --------------------------------------------------------------
If lKeyHandle = 0 Then
regQuery_A_Key = ""
lRet = RegCloseKey(lKeyHandle) ' always close the handle
Exit Function
End If
' --------------------------------------------------------------
' Query the registry and determine the data type.
' --------------------------------------------------------------
lRet = RegQueryValueEx(lKeyHandle, sRegSubKey, 0&, _
lDataType, ByVal 0&, lBufferSize)
' --------------------------------------------------------------
' If no key handle was found then there is no key. Leave.
' --------------------------------------------------------------
If lKeyHandle = 0 Then
regQuery_A_Key = ""
lRet = RegCloseKey(lKeyHandle) ' always close the handle
Exit Function
End If
' --------------------------------------------------------------
' Make the API call to query the registry based on the type
' of data.
' --------------------------------------------------------------
Select Case lDataType
Case REG_SZ: ' String data (most common)
' Preload the receiving buffer area
sBuffer = Space(lBufferSize)
lRet = RegQueryValueEx(lKeyHandle, sRegSubKey, 0&, 0&, _
ByVal sBuffer, lBufferSize)
' If NOT a successful call then leave
If lRet <> ERROR_SUCCESS Then
regQuery_A_Key = ""
Else
' Strip out the string data
iPos = InStr(1, sBuffer, Chr(0))
' look for the first null char
If iPos > 0 Then
' if we found one, then save everything
'up to that point
regQuery_A_Key = Left(sBuffer, iPos - 1)
Else
' did not find one. Save everything.
regQuery_A_Key = sBuffer
End If
End If
Case REG_DWORD: ' Numeric data (Integer)
lRet = RegQueryValueEx(lKeyHandle, sRegSubKey, _
0&, lDataType, lBuffer, 4&)
' 4& = 4-byte word (long integer)
' If NOT a successful call then leave
If lRet <> ERROR_SUCCESS Then
regQuery_A_Key = ""
Else
' Save the captured data
regQuery_A_Key = lBuffer
End If
Case Else: ' unknown
regQuery_A_Key = ""
End Select
' --------------------------------------------------------------
' Always close the handle in the registry. We do not want to
' corrupt these files.
' --------------------------------------------------------------
lRet = RegCloseKey(lKeyHandle)
End Function
Private Function GetFileExtension(pFileName As String) As String
Dim i As Integer
i = Len(pFileName)
While Mid(pFileName, i, 1) <> "."
i = i - 1
If i = 0 Then
MsgBox "No extension specified...", vbCritical, "Error"
Exit Function
End If
Wend
GetFileExtension = Right(pFileName, Len(pFileName) - i)
End Function
Opens any file/document in its associated application. Provided the extension is registered in syst Comments
No comments yet — be the first to post one!
Post a Comment