Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

FILE OPEN / SAVE DIALOG HELP! 1

Status
Not open for further replies.

simoncpage

Programmer
Apr 4, 2002
256
GB
Just looking through the basic "Display the Open Dialog" (as below). My problem is in office 2000 in the open dialog box if you type in a value for a directory and that file doesn't actually exist it filters the contents of the directory so that it displays all the file that have that value in them. i.e of you type 1000 in the file box 1000hello will be shown above. How can I modify the code so that it does this instead of displaying "File does not exist msgbox?"

any help would be most appreciated!

Simon

-----------------------------------------------------------

Option Explicit
'// type that passes/returns value through ShowOpenDialog function
Public Type stcFileStruct
strFileName As String
strFileTitle As String
strFilter As String
strDialogtitle As String
lngFilterIndex As Long
blnReadOnly As Boolean
End Type
'// Max filename and path constants
Const cMaxPath = 260
Const cMaxFile = 260
'// Open File name type
Private Type OPENFILENAME
lStructSize As Long ' Filled with UDT size
hWndOwner As Long ' Tied to Owner
hInstance As Long ' Ignored (used only by templates)
lpStrFilter As String ' Tied to Filter
lpStrCustomFilter As String ' Ignored
nMaxCustFilter As Long ' Ignored
nFilterIndex As Long ' Tied to FilterIndex
lpStrFile As String ' Tied to FileName
nMaxFile As Long ' Handled internally
lpStrFileTitle As String ' Tied to FileTitle
nMaxFileTitle As Long ' Handled internally
lpStrInitialDir As String ' Tied to InitDir
lpStrTitle As String ' Tied to DlgTitle
Flags As Long ' Tied to Flags
nFileOffset As Integer ' Ignored
nFileExtension As Integer ' Ignored
lpStrDefExt As String ' Tied to DefaultExt
lCustData As Long ' Ignored (needed for hooks)
lpfnHook As Long ' Ignored (good luck with hooks)
lpTemplateName As Long ' Ignored (good luck with templates)
End Type

Private Declare Function GetOpenFileName Lib "COMDLG32" _
Alias "GetOpenFileNameA" (File As OPENFILENAME) As Long
'// flags
Public Enum EOpenFile
OFN_READONLY = &H1
OFN_OVERWRITEPROMPT = &H2
OFN_HIDEREADONLY = &H4
OFN_NOCHANGEDIR = &H8
OFN_SHOWHELP = &H10
OFN_ENABLEHOOK = &H20
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_NOVALIDATE = &H100
OFN_ALLOWMULTISELECT = &H200
OFN_EXTENSIONDIFFERENT = &H400
OFN_PATHMUSTEXIST = &H800
OFN_FILEMUSTEXIST = &H1000
OFN_CREATEPROMPT = &H2000
OFN_SHAREAWARE = &H4000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NONETWORKBUTTON = &H20000
OFN_NOLONGNAMES = &H40000
OFN_EXPLORER = &H80000
OFN_NODEREFERENCELINKS = &H100000
OFN_LONGNAMES = &H200000
End Enum
'// Main function
Function VBGetOpenFileName(Filename As String, _
Optional FileTitle As String, _
Optional FileMustExist As Boolean = True, _
Optional MultiSelect As Boolean = False, _
Optional ReadOnly As Boolean = False, _
Optional HideReadOnly As Boolean = False, _
Optional Filter As String = "All (*.*)| *.*", _
Optional FilterIndex As Long = 1, _
Optional InitDir As String, _
Optional DlgTitle As String, _
Optional DefaultExt As String, _
Optional Owner As Long = -1, _
Optional Flags As Long = 0) As Boolean

Dim opfile As OPENFILENAME, s As String, afFlags As Long
With opfile
.lStructSize = Len(opfile)

' Add in specific flags and strip out non-VB flags
.Flags = (-FileMustExist * OFN_FILEMUSTEXIST) Or _
(-MultiSelect * OFN_ALLOWMULTISELECT) Or _
(-ReadOnly * OFN_READONLY) Or _
(-HideReadOnly * OFN_HIDEREADONLY) Or _
(Flags And CLng(Not (OFN_ENABLEHOOK Or _
OFN_ENABLETEMPLATE)))
' Owner can take handle of owning window
If Owner <> -1 Then .hWndOwner = Owner
' InitDir can take initial directory string
.lpStrInitialDir = InitDir
' DefaultExt can take default extension
.lpStrDefExt = DefaultExt
' DlgTitle can take dialog box title
.lpStrTitle = DlgTitle

' To make Windows-style filter, replace | and : with nulls
Dim ch As String, I As Integer
For I = 1 To Len(Filter)
ch = Mid$(Filter, I, 1)
If ch = &quot;|&quot; Or ch = &quot;:&quot; Then
'If ch = &quot;&quot; Or ch = &quot;&quot; Then
s = s & vbNullChar
Else
s = s & ch
End If
Next
' Put double null at end
s = s & vbNullChar & vbNullChar
.lpStrFilter = s
.nFilterIndex = FilterIndex

' Pad file and file title buffers to maximum path
s = Filename & String$(cMaxPath - Len(Filename), 0)
.lpStrFile = s
.nMaxFile = cMaxPath
s = FileTitle & String$(cMaxFile - Len(FileTitle), 0)
.lpStrFileTitle = s
.nMaxFileTitle = cMaxFile
' All other fields set to zero

If GetOpenFileName(opfile) Then
VBGetOpenFileName = True
Filename = StrZToStr(.lpStrFile)
FileTitle = StrZToStr(.lpStrFileTitle)
Flags = .Flags
' Return the filter index
FilterIndex = .nFilterIndex
' Look up the filter the user selected and return that
Filter = FilterLookup(.lpStrFilter, FilterIndex)
If (.Flags And OFN_READONLY) Then ReadOnly = True
Else
VBGetOpenFileName = False
Filename = Empty
FileTitle = Empty
Flags = 0
FilterIndex = -1
Filter = Empty
End If
End With
End Function
'// convert the filter to standard required by windows api
Private Function FilterLookup(ByVal sFilters As String, ByVal iCur As Long)

Dim iStart As Long, iEnd As Long, s As String

iStart = 1

If sFilters = Empty Then Exit Function
Do
' Cut out both parts marked by null character
iEnd = InStr(iStart, sFilters, vbNullChar)
If iEnd = 0 Then Exit Function
iEnd = InStr(iEnd + 1, sFilters, vbNullChar)
If iEnd Then
s = Mid$(sFilters, iStart, iEnd - iStart)
Else
s = Mid$(sFilters, iStart)
End If
iStart = iEnd + 1
If iCur = 1 Then
FilterLookup = s
Exit Function
End If
iCur = iCur - 1
Loop While iCur
End Function
'// show open dialog function (pass/return filestruct)
Public Function ShowOpenDialog(filestruct As stcFileStruct) As Boolean
With filestruct
If .strFilter = Empty Then .strFilter = &quot;All Files|*.*&quot;
ShowOpenDialog = VBGetOpenFileName(.strFileName, .strFileTitle, True, , .blnReadOnly, , .strFilter, .lngFilterIndex, , .strDialogtitle)
End With
StripFileStruct filestruct '// Return FileStruct
End Function
'// Removes nulls from the two strings in stcFileStruct
Private Sub StripFileStruct(filestruct As stcFileStruct)
With filestruct
.strFileName = StripTerminator(.strFileName)
.strFileTitle = StripTerminator(.strFileTitle)
End With
End Sub
'// Removes trailing nulls from a string
Function StripTerminator(ByVal strString As String) As String
Dim intZeroPos As Integer
intZeroPos = InStr(strString, Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString, intZeroPos - 1)
Else
StripTerminator = strString
End If
End Function

Function StrZToStr(s As String) As String
StrZToStr = Left$(s, Len(s))
End Function
 
I've not played with your code, but you might try throwing a wild card character in your file search string. 1000* for example.
&quot;The Key, The Whole Key, and Nothing But The Key, So Help Me Codd!&quot;
 
Thats great thanks! I never thought of using a wild card - simple solutions are so satisfying!

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top