Open a folder from a macro

[redsteve11]

What is the easiest way to open a folder with a command button on a form. (Access 97)

Let's say the folder path is...
c:\My Documents\New Folder

TIA

 

[lamarw]

It sounds like what you want to do is browse a folder, is this correct or do you want to ultimately open a file in a particular folder?

If you want to open a file in a folder then something simple like:

Open Application.CurrentProject.Path + Filename For Input As #1
Line Input #1, info

However if you want to open a folder to browse the folder then I suggest using the API. MSAccess doesn't have a very 'pretty' way of building a DriveListBox,FolderListBox,FileListBox. Lots of attempts but none that look professional or native.

Using the Windows Folder browser allows you to browse network locations as well.

If you need more info on the API respond and I or someone else will be glad to help you.

Lamar

 

[redsteve11]

Thanks Lamar, I want to browse a folder so the user can choose the file from that folder

I set up the hyperlink property of the command button to open the folder, but it brings it up in Explorer, and I am trying to see if there are any other options.

Thanks again

 

[lamarw]

This is a piece of code that I retrieved for making a file manager box pop when you want to look for folders and files. If you have any questions let me know. Some of the below has been modified but I think you'll be able to tell what's its doing.
Below there are three modules and a Sub (at the bottom). Put a button on a form and put the sub in the click event of the button.

'Name this module 'modCommonDialogActiveX'
Option Compare Database
Option Explicit

Public gInitDir As String
Public gSaveAsInitDir As String
Public gFileName As String
Public gSaveAsFileName As String
Public gPath As String
Public gSaveAsPath As String
Public gCommonDialog As Control

Public Function OpenCommonDialog()
With gCommonDialog
gInitDir = "c:\"
.InitDir = gInitDir
.FileName = gInitDir
' .Filter = "All Files (*.*)|*.*|" & _
' "Access Databases (*.mdb;*.mde;*.adp;*.ade)|*.mdb;*.mde;*.adp;*.ade|" & _
' "Excel Files (*.xl*)|*.xl*|" & _
' "Text Files (*.txt)|*.txt|" & _
' "Word Documents (*.doc;*.rtf)|*.doc;*.rtf|"
' .FileName = "Select the target directory then Click 'Open'" 'tell the user what to do
' .Filter = "No Files|*.No Files|" 'don't show any files
.Filter = "Picture Files (*.jpg;*.jpeg;*.bmp)|*.jpg;*.jpeg;*.bmp|" 'show limited picture files
.CancelError = True
.ShowOpen
gFileName = .FileName
OpenCommonDialog = gFileName
End With
Exit Function
ErrOpenCommonDialog:
gFileName = vbNullString
End Function
Public Function ““OpenCommonDialog()
With gCommonDialog
gInitDir = "c:\"
.InitDir = gInitDir
.FileName = gInitDir
' .Filter = "All Files (*.*)|*.*|" & _
' "Access Databases (*.mdb;*.mde;*.adp;*.ade)|*.mdb;*.mde;*.adp;*.ade|" & _
' "Excel Files (*.xl*)|*.xl*|" & _
' "Text Files (*.txt)|*.txt|" & _
' "Word Documents (*.doc;*.rtf)|*.doc;*.rtf|"
' .FileName = "Select the target directory then Click 'Open'" 'tell the user what to do
' .Filter = "No Files|*.No Files|" 'don't show any files
.Filter = "Picture Files (*.jpg;*.jpeg;*.bmp)|*.jpg;*.jpeg;*.bmp|" 'show limited picture files
.CancelError = True
.ShowOpen
gFileName = .FileName
OpenCommonDialog = gFileName
End With
Exit Function
ErrOpenCommonDialog:
gFileName = vbNullString
End Function

Public Function SaveAsCommonDialog()
With gCommonDialog
.InitDir = gSaveAsInitDir
.FileName = "Copy of " & gFileName
.Filter = "All Files (*.*)|*.*|"
.CancelError = True
.ShowSave
gSaveAsFileName = .FileName
SaveAsCommonDialog = gSaveAsFileName
End With
Exit Function
ErrOpenCommonDialog:
gSaveAsFileName = vbNullString
End Function

Public Function GetFileInfo(strPathAndFileName As String)
Dim i As Integer, j As Integer, intCurrPos As Integer
Dim intNextPos As Integer, intFinalPos As Integer, intLength As Integer
intCurrPos = 1
intLength = Len(strPathAndFileName)
For i = 1 To intLength Step intCurrPos
intNextPos = InStr(intCurrPos + 1, strPathAndFileName, "\")
If intNextPos = 0 Then
gFileName = Mid(strPathAndFileName, intCurrPos + 1, intLength)
intFinalPos = intCurrPos
End If
intCurrPos = intNextPos
Next i
gPath = Mid(strPathAndFileName, 1, intFinalPos - 1)
gInitDir = gPath
End Function

Public Function GetSaveAsFileInfo(strPathAndFileName As String)
Dim i As Integer, j As Integer, intCurrPos As Integer
Dim intNextPos As Integer, intFinalPos As Integer, intLength As Integer
intCurrPos = 1
intLength = Len(strPathAndFileName)
For i = 1 To intLength Step intCurrPos
intNextPos = InStr(intCurrPos + 1, strPathAndFileName, "\")
If intNextPos = 0 Then
gSaveAsFileName = Mid(strPathAndFileName, intCurrPos + 1, intLength)
intFinalPos = intCurrPos
End If
intCurrPos = intNextPos
Next i
gSaveAsPath = Mid(strPathAndFileName, 1, intFinalPos - 1)
gSaveAsInitDir = gPath
End Function

Public Function MoveCommonDialog()
With gCommonDialog
.InitDir = gSaveAsInitDir
.FileName = gFileName
.Filter = "All Files (*.*)|*.*|"
.CancelError = True
.ShowSave
gSaveAsFileName = .FileName
MoveCommonDialog = gSaveAsFileName
End With
Exit Function
ErrOpenCommonDialog:
gSaveAsFileName = vbNullString
End Function

===========================================================

'Name this module'modCommonDialogAPI'
Option Compare Database
Option Explicit

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Type MSA_OPENFILENAME
strFilter As String
lngFilterIndex As Long
strInitialDir As String
strInitialFile As String
strDialogTitle As String
strDefaultExtension As String
lngFlags As Long
strFullPathReturned As String
strFileNameReturned As String
intFileOffset As Integer
intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Public glFileName As String
Public glSaveAsFileName As String
Public glPath As String
Public glSaveAsPath As String
Public glInitDir As String
Public glSaveAsInitDir As String


Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer
intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 0 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
strFilter = strFilter & vbNullChar
Else
strFilter = ""
End If
MSA_CreateFilterString = strFilter
End Function

Function MSA_ConvertFilterString(strFilterIn As String) As String
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = ""
intNum = 0
intPos = 1
intLastPos = 1
Do
intPos = InStr(intLastPos, strFilterIn, "|")
If (intPos > intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If
If intNum Mod 2 = 1 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
If strFilter <> "" Then
strFilter = strFilter & vbNullChar
End If
MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
of.flags = of.flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetSaveFileName = intRet
If intRet = 0 Then
Err.Raise 5
End If
End Function

Function Find_SaveAsFile(strSearchPath) As String
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
msaof.strInitialDir = strSearchPath
intRet = MSA_GetSaveFileName(msaof)
Find_SaveAsFile = Trim(msaof.strFullPathReturned)
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet
End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub

Private Sub MSAOF_tF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
Dim strFile As String * 512
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 1
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile _
& String(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub

Function Find_File(strSearchPath) As String
Dim msaof As MSA_OPENFILENAME
msaof.strDialogTitle = "Select A File"
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString _
("All Files (*.*)", "*.*", _
"Access Databases (*.mdb;*.mde;*.adp;*.ade)", "*.mdb;*.mde;*.adp;*.ade", _
"Excel Files (*.xl*)", "*.xl*", _
"Text Files (*.txt)", "*.txt", _
"Word Documents (*.doc;*.rtf)", "*.doc;*.rtf")
MSA_GetOpenFileName msaof
Find_File = Trim(msaof.strFullPathReturned)
End Function

Public Function GetFileInformation(strPathAndFileName As String)
Dim i As Integer, j As Integer, intCurrPos As Integer, intNextPos As Integer
Dim intFinalPos As Integer, intLength As Integer
intCurrPos = 1
intLength = Len(strPathAndFileName)
For i = 1 To intLength Step intCurrPos
intNextPos = InStr(intCurrPos + 1, strPathAndFileName, "\")
If intNextPos = 0 Then
glFileName = Mid(strPathAndFileName, intCurrPos + 1, intLength)
intFinalPos = intCurrPos
End If
intCurrPos = intNextPos
Next i
glPath = Mid(strPathAndFileName, 1, intFinalPos - 1)
glInitDir = glPath
End Function

Public Function GetSaveAsFileInformation(strPathAndFileName As String)
Dim i As Integer, j As Integer, intCurrPos As Integer, intNextPos As Integer
Dim intFinalPos As Integer, intLength As Integer
intCurrPos = 1
intLength = Len(strPathAndFileName)
For i = 1 To intLength Step intCurrPos
intNextPos = InStr(intCurrPos + 1, strPathAndFileName, "\")
If intNextPos = 0 Then
glSaveAsFileName = Mid(strPathAndFileName, intCurrPos + 1, intLength)
intFinalPos = intCurrPos
End If
intCurrPos = intNextPos
Next i
glSaveAsPath = Mid(strPathAndFileName, 1, intFinalPos - 1)
glSaveAsInitDir = glSaveAsPath
End Function

===========================================================

'Name this module 'modShellExecute'

Option Compare Database
Option Explicit

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

Public Const ERROR_FILE_NOT_FOUND = 2
Public Const ERROR_PATH_NOT_FOUND = 3
Public Const ERROR_BAD_FORMAT = 11
Public Const SE_ERR_ACCESSDENIED = 5
Public Const SE_ERR_ASSOCINCOMPLETE = 27
Public Const SE_ERR_DDEBUSY = 30
Public Const SE_ERR_DDEFAIL = 29
Public Const SE_ERR_DDETIMEOUT = 28
Public Const SE_ERR_DLLNOTFOUND = 32
Public Const SE_ERR_FNF = 2
Public Const SE_ERR_NOASSOC = 31
Public Const SE_ERR_OOM = 8
Public Const SE_ERR_PNF = 3
Public Const SE_ERR_SHARE = 26

Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9

'==========================================================

'then in a button click event put this:
Private Sub Command1_Click()
Dim FileInfo As String

On Error GoTo ErrCommonDialog6
Set gCommonDialog = Me!CommonDialog6
FileInfo = OpenCommonDialog
GetFileInfo (FileInfo)
stop 'when you get here look into the variables and see what you see. The code can be modified from here to do what ever you want
' Me!txtPath = gPath & "\"
' Me!txtFile = gFileName
' Me!txtPathAndFile = gPath & "\" & gFileName
Exit Sub
ErrCommonDialog6:
If Err.Number = 32755 Then
Exit Sub
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub