Display the Open & Save Dialog

Here is another version of some code that allows you to display the open and save dialog boxes without having to use the large common dialog control (and without you needing a form to put it on).

'--------------------------------------'
'            Ariad Development Library '
'                          Version 3.0 '
'--------------------------------------'
'                  File Common Dialogs '
'                          Version 2.0 '
'--------------------------------------'
'Copyright © 1999 by Ariad Software. All Rights Reserved.

'Created        : 21/09/1999
'Completed      :
'Last Updated   :


Option Explicit
DefInt A-Z

Public Declare Function CommDlgExtendedError Lib "COMDLG32.DLL" () As Long
Public Declare Function GetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Type OPENFILENAME
 lStructSize        As Long
 hWndOwner          As Long
 hInstance          As Long
 lpStrFilter        As String
 lpStrCustomFilter  As String
 nMaxCustFilter     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
 lCustData          As Long
 lpfnHook           As Long
 lpTemplateName     As String
End Type

Public Enum CDFileModes
 cdfmOpenFile
 cdfmOpenFileOrPrompt
 cdfmSaveFile
 cdfmSaveFileNoConfirm
End Enum

Public Enum CDFileFlags
 OFN_ALLOWMULTISELECT = &H200
 OFN_CREATEPROMPT = &H2000
 OFN_ENABLEHOOK = &H20
 OFN_ENABLETEMPLATE = &H40
 OFN_ENABLETEMPLATEHANDLE = &H80
 OFN_EXPLORER = &H80000
 OFN_EXTENSIONDIFFERENT = &H400
 OFN_FILEMUSTEXIST = &H1000
 OFN_HIDEREADONLY = &H4
 OFN_LONGNAMES = &H200000
 OFN_NOCHANGEDIR = &H8
 OFN_NODEREFERENCELINKS = &H100000
 OFN_NOLONGNAMES = &H40000
 OFN_NONETWORKBUTTON = &H20000
 OFN_NOREADONLYRETURN = &H8000
 OFN_NOTESTFILECREATE = &H10000
 OFN_NOVALIDATE = &H100
 OFN_OVERWRITEPROMPT = &H2
 OFN_PATHMUSTEXIST = &H800
 OFN_READONLY = &H1
 OFN_SHAREAWARE = &H4000
 OFN_SHAREFALLTHROUGH = 2
 OFN_SHAREWARN = 0
 OFN_SHARENOWARN = 1
 OFN_SHOWHELP = &H10
 OFS_MAXPATHNAME = 128
End Enum

Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_NODEREFERENCELINKS Or OFN_HIDEREADONLY
Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST

Public OFN As OPENFILENAME
'----------------------------------------------------------------------
'Name        : SelectFile
'Created     : 21/09/1999 08:02
'----------------------------------------------------------------------
'Author      : Richard Moss
'Organisation: Ariad Software
'----------------------------------------------------------------------
'Description : Displays an API created file common dialog and returns
'              the name of the selected file.
'----------------------------------------------------------------------
'Returns     : Returns a String Variable
'----------------------------------------------------------------------
'Updates     :
'
'----------------------------------------------------------------------
'                              Ariad Procedure Builder Add-In 1.00.0027
Public Function SelectFile(ByVal hWndOwner As Long, Optional ByVal Filter = "All Files (*.*)|*.*" As String, Optional ByVal DefaultExtension = "" As String, Optional ByVal FileMode As CDFileModes = cdfmOpenFile, Optional ByVal DialogCaption = "" As String, Optional ByVal DefaultFilename = "" As String, Optional ByVal DefaultPath = "" As String, Optional FilterIDX As Long = 0, Optional MoreFlags As CDFileFlags) As String
 Dim R As Long, SP As Long, ShortSize As Long, Z As Long
 'determine defaults
 If InStr(DefaultFilename, "\") Then
  DefaultPath = GetPath(DefaultFilename)
  DefaultFilename = GetFile(DefaultFilename)
 End If
 If Len(DefaultPath) = 0 Then DefaultPath = CurDir$
 'fill structure
 With OFN
  .lStructSize = Len(OFN)
  .hWndOwner = hWndOwner
  .hInstance = App.hInstance
  .lpStrFilter = Replace$(Filter, "|", Chr$(0)) & Chr$(0)
  .nFilterIndex = FilterIDX
  .lpStrFile = DefaultFilename & String$(257 - Len(DefaultFilename), 0)
  .nMaxFile = Len(.lpStrFile) - 1
  .lpStrFileTitle = .lpStrFile
  .nMaxFileTitle = .nMaxFile
  .lpStrDefExt = DefaultExtension & Chr$(0)
  .lpStrInitialDir = DefaultPath & Chr$(0)
  .lpStrTitle = DialogCaption & Chr$(0)
  If FileMode = cdfmSaveFile Or FileMode = cdfmSaveFileNoConfirm Then
   'flags for save dialog
   .Flags = OFS_FILE_SAVE_FLAGS
   If FileMode = cdfmSaveFileNoConfirm Then .Flags = .Flags Or OFN_OVERWRITEPROMPT
   R = GetSaveFileName(OFN)
  ElseIf FileMode = cdfmOpenFile Or FileMode = cdfmOpenFileOrPrompt Then
   'flags for open dialog
   .Flags = OFS_FILE_OPEN_FLAGS
   If FileMode = cdfmOpenFileOrPrompt Then .Flags = .Flags Or OFN_CREATEPROMPT
   R = GetOpenFileName(OFN)
  End If
  'returnfilename
  If R Then
   SP = InStr(.lpStrFile, Chr$(0))
   If SP Then .lpStrFile = Left$(.lpStrFile, SP - 1)
   SelectFile = Trim$(Replace$(.lpStrFile, Chr$(0), ""))
  Else
   Z = CommDlgExtendedError()
   If Z Then MsgBox "Unable to get filename(s)." & vbCr & vbCr & "CommDlgExtendedError returned " & Z, vbCritical
  End If
 End With
End Function '(Public) Function SelectFile () As String


'----------------------------------------------------------------------
'Name        : GetFile
'Created     : 06/07/1999 12:36
'Modified    :
'----------------------------------------------------------------------
'Author      : Richard Moss
'Organisation: Ariad Software
'----------------------------------------------------------------------
'Description : Extracts the filename from a path
'----------------------------------------------------------------------
'Returns     : Returns the extracted filename, or the original string if no path exists
'----------------------------------------------------------------------
Private Function GetFile(ByVal PathAndFile As String) As String
 Dim R() As String
 If Len(PathAndFile) Then
  R() = Split(PathAndFile, "\")
  GetFile = R(UBound(R))
 End If
End Function '(Public) Function GetFile () As String

'----------------------------------------------------------------------
'Name        : GetPath
'Created     : 08/08/1999 09:07
'Modified    :
'Modified By :
'----------------------------------------------------------------------
'Author      : Richard James Moss
'Organisation: Ariad Software
'----------------------------------------------------------------------
'Description : Removes the filename from path
'----------------------------------------------------------------------
'Returns     : Returns the path minus it's filename
'----------------------------------------------------------------------
Private Function GetPath(ByVal Filename As String) As String
 Dim R() As String, P As String
 Dim I
 If InStr(Filename, "\") Then
  R() = Split(Filename, "\")
  For I = 0 To UBound(R) - 1
   P = P + R(I) + "\"
  Next
 End If
 GetPath = P
End Function '(Public) Function GetPath () As String

You might also like...

Comments

James Crowley James first started this website when learning Visual Basic back in 1999 whilst studying his GCSEs. The site grew steadily over the years while being run as a hobby - to a regular monthly audience ...

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“Computer Science is no more about computers than astronomy is about telescopes.” - E. W. Dijkstra