Module to open folder

[Emma35]

Hi Guys,
I'm using the module below, along with some code attached to the OnClick event of a command button to open a folder on a network drive. I'm wondering is it possible to just get the folder itself to open without the Explorer window appearing on the left of the screen ?

An example of the code on the command button would be

Private Sub cmd_OpenSanit_Click()
ShellToFile "S:\Quality Systems\Sanitation", , SW_SHOWMAXIMIZED
End Sub

Module

Option Compare Database
Option Explicit
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const OP_OPEN = "Open"
Public Const OP_PRINT = "Print"
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 nshowcm As Long)
Sub ShellToFile(strPath As String, _
           Optional strOperation As String = OP_OPEN, _
           Optional lngShow As Long = SW_SHOWNORMAL)
   Dim lngRetVal As Long
   Dim lngHwnd As Long
   
   lngHwnd = Application.hWndAccessApp
   
   lngRetVal = ShellExecute(lngHwnd, strOperation, strPath, _
       vbNullString, CurDir, lngShow)
       
   If lngRetVal < 32 Then
       MsgBox "Unable to open file " & strPath, vbInformation, "Warning"
   End If
   
End Sub

Any help would be great
Thanks,
Em

 

[Rx_]

This is some code in my file from a while back for Excel. Will post it to see if there are any other constants that might be useful in the Public Enum ShowType.

Option Compare Database
Option Explicit
' --------------------- shell module -----------------
Private Declare Function FindWindow& Lib "user32.dll" Alias "FindWindowA" _
                        (ByVal lpClassName As String, _
                         ByVal lpWindowName As String)
'ShellExecute documentation:
'http://support.microsoft.com/?kbid=2382458.'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/functions/shellexecute.asp
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)
 'Error value constants
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
'ShellExecute display flags
Public Enum ShowType
    SW_HIDE = 0
    SW_SHOWNORMAL = 1
    SW_SHOWMINIMIZED = 2
    SW_MAXIMIZE = 3
    SW_SHOWNOACTIVATE = 4
    SW_SHOW = 5
    SW_MINIMIZE = 6
    SW_SHOWMINNOACTIVE = 7
    SW_SHOWNA = 8
    SW_RESTORE = 9
End Enum
'ShellExecute operation flags
Public Enum ExploreType
    ExecuteExplore = 0
    ExecuteOpen = 1
    ExecutePrint = 2
    ExecuteFind = 3
End Enum
 
 
Public Function fbShellOut(ByRef lExecute As ExploreType, _
                            ByRef szPath As String, _
                            ByRef lDisplay As ShowType) As Boolean
          Dim lResp As Long
          Dim lHwnd As Long
          Dim vTask As Variant
 
 
          Dim szAction As String
          'How to execute
10        Select Case lExecute
              Case 0
20                szAction = "explore"
30            Case 1
40                szAction = "open"
50            Case 2
60                szAction = "print"
70           Case 3
80                szAction = "find"
90       End Select
 
          'Find the handle to this excel window
100       If Val(Application.Version) >= 10 Then
              ' lHwnd = Application.hwnd ' This runs in Excel won't compile in Access
110       Else
120           lHwnd = FindWindow("XLMAIN", vbNullString)
130       End If
 
          'Try to shell first
140       lResp = ShellExecute(lHwnd, _
              szAction & vbNullChar, _
              szPath & vbNullChar, _
              vbNull, vbNull, lDisplay)
 
 
          'greater than 32, should work
150       If lResp > ERROR_SUCCESS Then
 
160           fbShellOut = True
 
170       Else
 
              'Less than 32,  return an error message
180           Select Case lResp
                  Case ERROR_NO_ASSOC:
190                   vTask = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                             & szPath, lDisplay)
200                   lResp = (vTask <> 0)
210               Case ERROR_OUT_OF_MEM:
220                   MsgBox "Error: Out of Memory/Resources. Couldn't Execute!", 16
230               Case ERROR_FILE_NOT_FOUND:
240                   MsgBox "Error: File not found.  Couldn't Execute!", 16
250               Case ERROR_PATH_NOT_FOUND:
260                   MsgBox "Error: Path not found. Couldn't Execute!", 16
270               Case ERROR_BAD_FORMAT:
280                   MsgBox "Error:  Bad File Format. Couldn't Execute!", 16
290               Case Else
300                  MsgBox "Error:  Unknown.  Couldn't Execute!", 16
310           End Select
 
320       End If
End Function
 
 
Public Sub TestLikeThis()
    'Use like this:
    fbShellOut ExecuteOpen, "c:\work\bypass.xls", SW_SHOWNORMAL
End Sub

 

[Emma35]

Thanks....not sure how it helps me though