alcutter
asked on
Open With Dialog Box VB6
Hi
I have a VB6 App. I use the shellexcute to open files. I want to give my users the ability to select an application to launch. I can not find any information on how to display the open with dialog box.
I have a VB6 App. I use the shellexcute to open files. I want to give my users the ability to select an application to launch. I can not find any information on how to display the open with dialog box.
Have you tried the Common Dialog Control?
you can add common dialog control:
Project->Components->Micro soft Common Dialog Control 6.0
Private Sub Command1_Click()
Dim pattern As String
'pattern = "Text (*.txt)|*.txt"
pattern = "Image Files (*.gif; *.bmp;*.jpg)| *.gif;*.bmp;*.jpg"
CommonDialog1.Filter = pattern
CommonDialog1.ShowSave
If CommonDialog1.FileName = "" Then
msgbox CommonDialog1.FileName
End If
End Sub
The above code will show the dialog and the user can select the path
************************** ********** ********** ********** ********** ********** ********** ********** **********
************************** ********** ********** ********** ********** ********** ********** ********** **********
this below code will show the file and folder browse list
Just add this module and call this function this will give the browse dialog and you can select the network path also.
Private Sub Browse(Optional ByVal bDontShowBrowser As Boolean)
sPath = GetInitEntry("Main", "Last Path", "C:\")
If Not bDontShowBrowser Then
sPath = BrowseForFolder(Me.hWnd, "Select a Path to save the settings file.", sPath)
End If
If Len(sPath) > 0 Then
On Error Resume Next
filHidden.Path = sPath
If Err.Number = 0 Then
lRet = SetInitEntry("Main", "Last Path", sPath)
End If
End If
End Sub
************************** ********** ********** ********** ********** ********** *********
///////////////////// selectpath.bas
************************** ********** ********** ********** ********** ********** *********
Option Explicit
'sDefInitFileName is setup as (AppPath\AppEXEName.Ini)
'and is used as the Default Initialization Filename
Private sDefInitFileName As String
' Maximum long filename path length
Private Const MAX_PATH = 1024
'SendMessage Constants
Private Const BFFM_INITIALIZED = 1
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
'The Following Constants may be passed to BrowseForFolder
'as vTopFolder or vSelPath
Public Const CSIDL_DESKTOP = &H0 'DeskTop
Public Const CSIDL_PROGRAMS = &H2 'Program Groups Folder
Public Const CSIDL_CONTROLS = &H3 'Control Panel Icons Folder
Public Const CSIDL_PRINTERS = &H4 'Printers Folder
Public Const CSIDL_PERSONAL = &H5 'Documents Folder
Public Const CSIDL_FAVORITES = &H6 'Favorites Folder
Public Const CSIDL_STARTUP = &H7 'Startup Folder
Public Const CSIDL_RECENT = &H8 'Recent folder
Public Const CSIDL_SENDTO = &H9 'SendTo Folder
Public Const CSIDL_BITBUCKET = &HA 'Recycle Bin Folder
Public Const CSIDL_STARTMENU = &HB 'Start Menu Folder
Public Const CSIDL_DESKTOPDIRECTORY = &H10 'Windows\Desktop Folder
Public Const CSIDL_DRIVES = &H11 'Devices Virtual Folder (My Computer)
Public Const CSIDL_NETWORK = &H12 'Network Neighborhood Virtual Folder
Public Const CSIDL_NETHOOD = &H13 'Network Neighborhood Folder
Public Const CSIDL_FONTS = &H14 'Fonts Folder
Public Const CSIDL_TEMPLATES = &H15 'ShellNew folder
Private Type SHItemID
cb As Long 'Size of the ID (including cb itself)
abID As Byte 'The item ID (variable length)
End Type
Private Type ItemIDList
mkid As SHItemID
End Type
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpCallbackProc As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'Retrieves the location of a special (system) folder.
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ItemIDList) As Long
'ParseDisplayName function should be used instead of this undocumented function.
Private Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal szPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileString A" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Select Case uMsg
Case BFFM_INITIALIZED
' Set the dialog's pre-selected folder using the pidl
' set in bi.lParam and passed in the lpData param.
Call SendMessage(hWnd, BFFM_SETSELECTIONA, False, ByVal lpData)
End Select
End Function
Public Function BrowseForFolder(hOwnerWnd As Long, Optional ByVal sInstruct As String, Optional vSelPath As Variant, Optional vTopFolder As Variant) As String
' Shows the Browse For Folder dialog
'
' hOwnerWnd (Long) OwnerWindow.hWnd.
' sInstruct (String) Instructions for user.
' vSelPath (String or CSIDL Constant) Pre-select this Folder.
' vTopFolder (String or CSIDL Constant) Set the Top folder.
'
' If successful, returns the selected folder's full path,
' returns an empty string otherwise.
'
Dim lRet As Long
Dim pidlRet As Long
Dim sPath As String * MAX_PATH
Dim lItemIDList As ItemIDList
Dim uBrowseInfo As BROWSEINFO
With uBrowseInfo
' The desktop will own the dialog
.hOwner = hOwnerWnd
' This will be the dialog's root folder.
If IsMissing(vTopFolder) Then
vTopFolder = CSIDL_DESKTOP
End If
If Len(vTopFolder) > 0 And Not IsNumeric(vTopFolder) Then
'String Path passed in
.pidlRoot = SHSimpleIDListFromPath(CSt r(vTopFold er))
Else
'Long CSIDL Special Folder Constant or Nothing passed in.
lRet = SHGetSpecialFolderLocation (ByVal hOwnerWnd, ByVal CLng(vTopFolder), lItemIDList)
.pidlRoot = lItemIDList.mkid.cb
End If
' Set the dialog's prompt string
.lpszTitle = sInstruct
' Obtain and set the address of the callback function
.lpCallbackProc = FarProc(AddressOf BrowseCallbackProc)
' Obtain and set the pidl of the pre-selected folder
If IsMissing(vSelPath) Then
'Nothing passed in
.lParam = .pidlRoot
ElseIf Len(vSelPath) > 0 And Not IsNumeric(vSelPath) Then
'String Path passed in
.lParam = SHSimpleIDListFromPath(CSt r(vSelPath ))
Else
'Long CSIDL Special Folder Constant passed in
lRet = SHGetSpecialFolderLocation (ByVal hOwnerWnd, ByVal CLng(vSelPath), lItemIDList)
.lParam = lItemIDList.mkid.cb
End If
End With
' Shows the browse dialog and doesn't return until the dialog is
' closed. The BrowseCallbackProc will receive all browse
' dialog specific messages while the dialog is open. pidlRet will
' contain the pidl of the selected folder if the dialog is not cancelled.
pidlRet = SHBrowseForFolder(uBrowseI nfo)
If pidlRet > 0 Then
' Get the path from the selected folder's pidl returned
' from the SHBrowseForFolder call (rtns True on success,
' sPath must be pre-allocated!)
If SHGetPathFromIDList(pidlRe t, sPath) Then
' Return the path
BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End If
' Free the memory the shell allocated for the pidl.
Call CoTaskMemFree(pidlRet)
End If
' Free the memory the shell allocated for the pre-selected folder.
Call CoTaskMemFree(uBrowseInfo. lParam)
End Function
Public Function FarProc(lpProcName As Long) As Long
'Returns the value of the AddressOf operator
FarProc = lpProcName
End Function
Public Function GetInitEntry(ByVal sSection As String, ByVal sKeyName As String, Optional ByVal sDefault As String = "", Optional ByVal sInitFileName As String = "") As String
'This Function Reads In a String From The Init File.
'Returns Value From Init File or sDefault If No Value Exists.
'sDefault Defaults to an Empty String ("").
'Creates and Uses sDefInitFileName (AppPath\AppEXEName.Ini)
'if sInitFileName Parameter Is Not Passed In.
Dim sBuffer As String
Dim sInitFile As String
'If Init Filename NOT Passed In
If Len(sInitFileName) = 0 Then
'If Static Init FileName NOT Already Created
If Len(sDefInitFileName) = 0 Then
'Create Static Init FileName
sDefInitFileName = App.Path
If Right$(sDefInitFileName, 1) <> "\" Then
sDefInitFileName = sDefInitFileName & "\"
End If
sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
End If
sInitFile = sDefInitFileName
Else 'If Init Filename Passed In
sInitFile = sInitFileName
End If
sBuffer = String$(2048, " ")
GetInitEntry = Left$(sBuffer, GetPrivateProfileString(sS ection, ByVal sKeyName, sDefault, sBuffer, Len(sBuffer), sInitFile))
End Function
Public Function SetInitEntry(ByVal sSection As String, Optional ByVal sKeyName As String, Optional ByVal sValue As String, Optional ByVal sInitFileName As String = "") As Long
'This Function Writes a String To The Init File.
'Returns WritePrivateProfileString Success or Error.
'Creates and Uses sDefInitFileName (AppPath\AppEXEName.Ini)
'if sInitFileName Parameter Is Not Passed In.
'***** CAUTION *****
'If sValue is Null then sKeyName is deleted from the Init File.
'If sKeyName is Null then sSection is deleted from the Init File.
Dim sInitFile As String
'If Init Filename NOT Passed In
If Len(sInitFileName) = 0 Then
'If Static Init FileName NOT Already Created
If Len(sDefInitFileName) = 0 Then
'Create Static Init FileName
sDefInitFileName = App.Path
If Right$(sDefInitFileName, 1) <> "\" Then
sDefInitFileName = sDefInitFileName & "\"
End If
sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
End If
sInitFile = sDefInitFileName
Else 'If Init Filename Passed In
sInitFile = sInitFileName
End If
If Len(sKeyName) > 0 And Len(sValue) > 0 Then
SetInitEntry = WritePrivateProfileString( sSection, ByVal sKeyName, ByVal sValue, sInitFile)
ElseIf Len(sKeyName) > 0 Then
SetInitEntry = WritePrivateProfileString( sSection, ByVal sKeyName, vbNullString, sInitFile)
Else
SetInitEntry = WritePrivateProfileString( sSection, vbNullString, vbNullString, sInitFile)
End If
End Function
Project->Components->Micro
Private Sub Command1_Click()
Dim pattern As String
'pattern = "Text (*.txt)|*.txt"
pattern = "Image Files (*.gif; *.bmp;*.jpg)| *.gif;*.bmp;*.jpg"
CommonDialog1.Filter = pattern
CommonDialog1.ShowSave
If CommonDialog1.FileName = "" Then
msgbox CommonDialog1.FileName
End If
End Sub
The above code will show the dialog and the user can select the path
**************************
**************************
this below code will show the file and folder browse list
Just add this module and call this function this will give the browse dialog and you can select the network path also.
Private Sub Browse(Optional ByVal bDontShowBrowser As Boolean)
sPath = GetInitEntry("Main", "Last Path", "C:\")
If Not bDontShowBrowser Then
sPath = BrowseForFolder(Me.hWnd, "Select a Path to save the settings file.", sPath)
End If
If Len(sPath) > 0 Then
On Error Resume Next
filHidden.Path = sPath
If Err.Number = 0 Then
lRet = SetInitEntry("Main", "Last Path", sPath)
End If
End If
End Sub
**************************
///////////////////// selectpath.bas
**************************
Option Explicit
'sDefInitFileName is setup as (AppPath\AppEXEName.Ini)
'and is used as the Default Initialization Filename
Private sDefInitFileName As String
' Maximum long filename path length
Private Const MAX_PATH = 1024
'SendMessage Constants
Private Const BFFM_INITIALIZED = 1
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
'The Following Constants may be passed to BrowseForFolder
'as vTopFolder or vSelPath
Public Const CSIDL_DESKTOP = &H0 'DeskTop
Public Const CSIDL_PROGRAMS = &H2 'Program Groups Folder
Public Const CSIDL_CONTROLS = &H3 'Control Panel Icons Folder
Public Const CSIDL_PRINTERS = &H4 'Printers Folder
Public Const CSIDL_PERSONAL = &H5 'Documents Folder
Public Const CSIDL_FAVORITES = &H6 'Favorites Folder
Public Const CSIDL_STARTUP = &H7 'Startup Folder
Public Const CSIDL_RECENT = &H8 'Recent folder
Public Const CSIDL_SENDTO = &H9 'SendTo Folder
Public Const CSIDL_BITBUCKET = &HA 'Recycle Bin Folder
Public Const CSIDL_STARTMENU = &HB 'Start Menu Folder
Public Const CSIDL_DESKTOPDIRECTORY = &H10 'Windows\Desktop Folder
Public Const CSIDL_DRIVES = &H11 'Devices Virtual Folder (My Computer)
Public Const CSIDL_NETWORK = &H12 'Network Neighborhood Virtual Folder
Public Const CSIDL_NETHOOD = &H13 'Network Neighborhood Folder
Public Const CSIDL_FONTS = &H14 'Fonts Folder
Public Const CSIDL_TEMPLATES = &H15 'ShellNew folder
Private Type SHItemID
cb As Long 'Size of the ID (including cb itself)
abID As Byte 'The item ID (variable length)
End Type
Private Type ItemIDList
mkid As SHItemID
End Type
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpCallbackProc As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'Retrieves the location of a special (system) folder.
Private Declare Function SHGetSpecialFolderLocation
'ParseDisplayName function should be used instead of this undocumented function.
Private Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal szPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA"
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileString
Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Select Case uMsg
Case BFFM_INITIALIZED
' Set the dialog's pre-selected folder using the pidl
' set in bi.lParam and passed in the lpData param.
Call SendMessage(hWnd, BFFM_SETSELECTIONA, False, ByVal lpData)
End Select
End Function
Public Function BrowseForFolder(hOwnerWnd As Long, Optional ByVal sInstruct As String, Optional vSelPath As Variant, Optional vTopFolder As Variant) As String
' Shows the Browse For Folder dialog
'
' hOwnerWnd (Long) OwnerWindow.hWnd.
' sInstruct (String) Instructions for user.
' vSelPath (String or CSIDL Constant) Pre-select this Folder.
' vTopFolder (String or CSIDL Constant) Set the Top folder.
'
' If successful, returns the selected folder's full path,
' returns an empty string otherwise.
'
Dim lRet As Long
Dim pidlRet As Long
Dim sPath As String * MAX_PATH
Dim lItemIDList As ItemIDList
Dim uBrowseInfo As BROWSEINFO
With uBrowseInfo
' The desktop will own the dialog
.hOwner = hOwnerWnd
' This will be the dialog's root folder.
If IsMissing(vTopFolder) Then
vTopFolder = CSIDL_DESKTOP
End If
If Len(vTopFolder) > 0 And Not IsNumeric(vTopFolder) Then
'String Path passed in
.pidlRoot = SHSimpleIDListFromPath(CSt
Else
'Long CSIDL Special Folder Constant or Nothing passed in.
lRet = SHGetSpecialFolderLocation
.pidlRoot = lItemIDList.mkid.cb
End If
' Set the dialog's prompt string
.lpszTitle = sInstruct
' Obtain and set the address of the callback function
.lpCallbackProc = FarProc(AddressOf BrowseCallbackProc)
' Obtain and set the pidl of the pre-selected folder
If IsMissing(vSelPath) Then
'Nothing passed in
.lParam = .pidlRoot
ElseIf Len(vSelPath) > 0 And Not IsNumeric(vSelPath) Then
'String Path passed in
.lParam = SHSimpleIDListFromPath(CSt
Else
'Long CSIDL Special Folder Constant passed in
lRet = SHGetSpecialFolderLocation
.lParam = lItemIDList.mkid.cb
End If
End With
' Shows the browse dialog and doesn't return until the dialog is
' closed. The BrowseCallbackProc will receive all browse
' dialog specific messages while the dialog is open. pidlRet will
' contain the pidl of the selected folder if the dialog is not cancelled.
pidlRet = SHBrowseForFolder(uBrowseI
If pidlRet > 0 Then
' Get the path from the selected folder's pidl returned
' from the SHBrowseForFolder call (rtns True on success,
' sPath must be pre-allocated!)
If SHGetPathFromIDList(pidlRe
' Return the path
BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End If
' Free the memory the shell allocated for the pidl.
Call CoTaskMemFree(pidlRet)
End If
' Free the memory the shell allocated for the pre-selected folder.
Call CoTaskMemFree(uBrowseInfo.
End Function
Public Function FarProc(lpProcName As Long) As Long
'Returns the value of the AddressOf operator
FarProc = lpProcName
End Function
Public Function GetInitEntry(ByVal sSection As String, ByVal sKeyName As String, Optional ByVal sDefault As String = "", Optional ByVal sInitFileName As String = "") As String
'This Function Reads In a String From The Init File.
'Returns Value From Init File or sDefault If No Value Exists.
'sDefault Defaults to an Empty String ("").
'Creates and Uses sDefInitFileName (AppPath\AppEXEName.Ini)
'if sInitFileName Parameter Is Not Passed In.
Dim sBuffer As String
Dim sInitFile As String
'If Init Filename NOT Passed In
If Len(sInitFileName) = 0 Then
'If Static Init FileName NOT Already Created
If Len(sDefInitFileName) = 0 Then
'Create Static Init FileName
sDefInitFileName = App.Path
If Right$(sDefInitFileName, 1) <> "\" Then
sDefInitFileName = sDefInitFileName & "\"
End If
sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
End If
sInitFile = sDefInitFileName
Else 'If Init Filename Passed In
sInitFile = sInitFileName
End If
sBuffer = String$(2048, " ")
GetInitEntry = Left$(sBuffer, GetPrivateProfileString(sS
End Function
Public Function SetInitEntry(ByVal sSection As String, Optional ByVal sKeyName As String, Optional ByVal sValue As String, Optional ByVal sInitFileName As String = "") As Long
'This Function Writes a String To The Init File.
'Returns WritePrivateProfileString Success or Error.
'Creates and Uses sDefInitFileName (AppPath\AppEXEName.Ini)
'if sInitFileName Parameter Is Not Passed In.
'***** CAUTION *****
'If sValue is Null then sKeyName is deleted from the Init File.
'If sKeyName is Null then sSection is deleted from the Init File.
Dim sInitFile As String
'If Init Filename NOT Passed In
If Len(sInitFileName) = 0 Then
'If Static Init FileName NOT Already Created
If Len(sDefInitFileName) = 0 Then
'Create Static Init FileName
sDefInitFileName = App.Path
If Right$(sDefInitFileName, 1) <> "\" Then
sDefInitFileName = sDefInitFileName & "\"
End If
sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
End If
sInitFile = sDefInitFileName
Else 'If Init Filename Passed In
sInitFile = sInitFileName
End If
If Len(sKeyName) > 0 And Len(sValue) > 0 Then
SetInitEntry = WritePrivateProfileString(
ElseIf Len(sKeyName) > 0 Then
SetInitEntry = WritePrivateProfileString(
Else
SetInitEntry = WritePrivateProfileString(
End If
End Function
ASKER
I use the Open file dialog in my App. I am looking for the Open With Dialog. I want to list the applications that are associated to a given file type and allow the user to select the application to open the file with.
ASKER
I found the solution the following code with display the Open With Dialog.
Dim llITLong As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
llITLong = ShellExecute(Scr_hDC, "open", "RUNDLL32.EXE", "shell32.dll,OpenAs_RunDLL c:\afc\afcsig1.bmp", "", SW_SHOWNORMAL)
Dim llITLong As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
llITLong = ShellExecute(Scr_hDC, "open", "RUNDLL32.EXE", "shell32.dll,OpenAs_RunDLL
Just add one button in the form and copy the following code.
Private Sub Command1_Click()
DisplayOpenWith "C:\Documents and Settings\Administrator\Des ktop\4.jpg "
End Sub
Public Sub DisplayOpenWith(strFile As String)
'***PURPOSE: DISPLAY OPEN WITH DIALOG:
' PASS IT A FILE NAME
' e.g., DisplayOpenWith "C:\FileWithNoDefaultAppli cation.bvq "
'************************* ********** ***
On Error Resume Next
Shell "rundll32.exe shell32.dll, OpenAs_RunDLL " & strFile
End Sub
i hope this will works for you
Regards,
M.Raja
Private Sub Command1_Click()
DisplayOpenWith "C:\Documents and Settings\Administrator\Des
End Sub
Public Sub DisplayOpenWith(strFile As String)
'***PURPOSE: DISPLAY OPEN WITH DIALOG:
' PASS IT A FILE NAME
' e.g., DisplayOpenWith "C:\FileWithNoDefaultAppli
'*************************
On Error Resume Next
Shell "rundll32.exe shell32.dll, OpenAs_RunDLL " & strFile
End Sub
i hope this will works for you
Regards,
M.Raja
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.