Hi All,
I have a browse button that the user can click to select a file. The button then fetches the file path. This is all working fine except my boss wants some add functionality. I need it to be so that the user can only access Z: and Y: and not W: or X:
Any help is highly appreciated. Thanks a lot
The current code I am using is is posted below. (this works just fine)
I have a browse button that the user can click to select a file. The button then fetches the file path. This is all working fine except my boss wants some add functionality. I need it to be so that the user can only access Z: and Y: and not W: or X:
Any help is highly appreciated. Thanks a lot
The current code I am using is is posted below. (this works just fine)
Code:
Option Explicit
Option Compare Database
Private 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
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Private strDialogTitle As String
Private intDefaultType As Integer
Private strNewTypes As String
Private strInitialFile As String
Private strInitialDir As String
Private strFilter As String
Private strFltrLst As String
Private strFltrCnt As String
' This 'Method' routine displays the Open dialog box for the user to
' locate the desired file. Returns the full path to the file.
Public Function GetFileSpec()
Dim of As OPENFILENAME
Dim intRet As Integer
'set up the file filter and the default type option
If strNewTypes <> "" Then
of.lpstrFilter = strNewTypes & strFilter
of.nFilterIndex = 1
Else
of.lpstrFilter = strFilter
If intDefaultType <> 0 Then
of.nFilterIndex = intDefaultType
Else
of.nFilterIndex = 1
End If
End If
'define some other dialog options
of.lpstrTitle = strDialogTitle
of.lpstrInitialDir = strInitialDir
of.lpstrFile = strInitialFile & String(512 - Len(strInitialFile), 0)
of.nMaxFile = 511
' Initialize other parts of the structure
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511
of.lpstrDefExt = vbNullChar
of.Flags = 0
of.lStructSize = Len(of)
'call the Open dialog routine
intRet = GetOpenFileName(of)
If intRet Then
GetFileSpec = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
Else
GetFileSpec = ""
End If
End Function 'End of GetFileSpec
'
' The following 'Property' routines define the Dialog Box properties
'
Public Property Let DialogTitle(strTitle As String)
'store the title for the dialog box
strDialogTitle = strTitle
End Property
Public Property Let AdditionalTypes(strAddTypes As String)
Dim posn As Integer
Dim I As Integer
'don't accept additional types if a default type has been specified
If intDefaultType <> 0 Then
MsgBox "You cannot use both the AdditionalTypes property (to add to the " & _
"file type filter) and the DefaultType property (to select which " & _
"file type will be the default). When the AdditionalTypes property " & _
"is used, the first file type in that property " & _
"is used as the default in the file type filter.", vbCritical, _
"Browse For File Dialog"
Exit Property
End If
'check for the "|" delimiter
posn = InStr(strAddTypes, "|")
'save the new parameter or report an error
If posn = 0 Then
MsgBox "The AdditionalTypes property string does not contain at least " & _
"one " & Chr$(34) & "|" & Chr$(34) & " character. " & _
"You must specify an AdditionalTypes property in the same " & _
"format that is shown in the " & _
"following examples: " & vbCrLf & vbCrLf & Chr$(34) & _
"Rich Text Files (*.rtf) | *.rtf" & Chr$(34) & vbCrLf & Chr$(34) & _
"My Files (*.mf1;*.mf2) | *.mf1;*.mf2 | " & _
"Your File (*.yrf) | *.yrf" & Chr$(34), vbCritical, _
"Browse For File Dialog"
strNewTypes = ""
Exit Property
Else
Do While True
If posn > 0 Then
strNewTypes = strNewTypes & Left$(strAddTypes, posn - 1) & vbNullChar
strAddTypes = Mid$(strAddTypes, posn + 1)
posn = InStr(1, strAddTypes, "|")
Else
strNewTypes = strNewTypes & vbNullChar
Exit Do
End If
Loop
End If
End Property 'End of AdditionalTypes
Public Property Let DefaultType(strType As String)
Dim posn As Integer
posn = InStr(strFltrLst, strType)
'don't accept a default if new types are being specified
If strNewTypes <> "" Then
MsgBox "You cannot use both the AdditionalTypes property (to add to the " & _
"file type filter) and the DefaultType property (to select which " & _
"file type will be the default). When the AdditionalTypes property " & _
"is used, the first file type in that property " & _
"is used as the default in the file type filter.", vbCritical, _
"Browse For File Dialog"
Exit Property
'make sure the selected default actually exists
ElseIf posn = 0 Then
MsgBox "The file type you specified in the DefaultType " & _
"property is not in the built-in " & _
"list of file types. You must either specify one of the " & _
"built-in file types or use the AdditionalTypes property " & _
"to specify a complete entry similar to the " & _
"following examples: " & vbCrLf & vbCrLf & Chr$(34) & _
"Rich Text Files (*.rtf) | *.rtf" & Chr$(34) & vbCrLf & Chr$(34) & _
"My Files (*.mf1;*.mf2) | *.mf1;*.mf2 | " & _
"Your File (*.yrf) | *.yrf" & Chr$(34), vbCritical, _
"Browse For File Dialog"
Exit Property
Else
'set up the selected default
intDefaultType = Trim$(Mid$(strFltrCnt, posn, 3))
End If
End Property
Public Property Let InitialFile(strIFile As String)
strInitialFile = strIFile
End Property
Public Property Let InitialDir(strIDir As String)
strInitialDir = strIDir
End Property
' This routine initializes the string constants that are used by this class
'
Private Sub Class_Initialize()
'define some initial conditions
strDialogTitle = "Browse For a File"
strInitialDir = ""
strInitialFile = ""
strNewTypes = ""
'define the filter string and the look-up strings
strFilter = "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar & _
"Text Files (*.txt;*.prn;*.csv)" & vbNullChar & "*.txt;*.prn;*.csv" & vbNullChar & _
"Word Documents (*.doc)" & vbNullChar & "*.doc" & vbNullChar & _
"Word Templates (*.dot)" & vbNullChar & "*.dot" & vbNullChar & _
"Excel Files (*.xls)" & vbNullChar & "*.xls" & vbNullChar & _
"Databases (*.mdb)" & vbNullChar & "*.mdb" & vbNullChar & _
"HTML Documents (*.html;*.htm)" & vbNullChar & "*.html;*.htm" & vbNullChar
strFltrLst = "*.* *.txt *.prn *.csv *.doc *.dot *.xls *.mdb *.html"
strFltrCnt = " 1 2 2 2 3 4 5 6 7 "
End Sub
Comment