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

'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below 
'are mine to save long statements; they're not 
'a standard Win32 type. 
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
             Or OFN_LONGNAMES _
             Or OFN_CREATEPROMPT _
             Or OFN_NODEREFERENCELINKS 

Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
             Or OFN_LONGNAMES _
             Or OFN_OVERWRITEPROMPT _
             Or OFN_HIDEREADONLY 

Public Type OPENFILENAME
  nStructSize       As Long
  hWndOwner         As Long
  hInstance         As Long
  sFilter           As String
  sCustomFilter     As String
  nMaxCustFilter    As Long
  nFilterIndex      As Long
  sFile             As String
  nMaxFile          As Long
  sFileTitle        As String
  nMaxTitle         As Long
  sInitialDir       As String
  sDialogTitle      As String
  flags             As Long
  nFileOffset       As Integer
  nFileExtension    As Integer
  sDefFileExt       As String
  nCustData         As Long
  fnHook            As Long
  sTemplateName     As String
End Type

Public OFN As OPENFILENAME 

Public Declare Function GetOpenFileName Lib "comdlg32" _
    Alias "GetOpenFileNameA" _ 
   (pOpenfilename As OPENFILENAME) As Long 

Public Declare Function GetSaveFileName Lib "comdlg32" _
   Alias "GetSaveFileNameA" _
  (pOpenfilename As OPENFILENAME) As Long

Public Declare Function GetShortPathName Lib "kernel32" _ 
    Alias "GetShortPathNameA" _ 
   (ByVal lpszLongPath As String, _
    ByVal lpszShortPath As String, _
    ByVal cchBuffer As Long) As Long 

Option Explicit

Private Sub Command1_Click()

  'used in call setup
   Dim sFilters As String
   
  'used after call
   Dim pos As Long
   Dim buff As String
   Dim sLongname As String
   Dim sShortname As String

  'create a string of filters for the dialog
   sFilters = "Visual Basic Forms" & vbNullChar & "*.frm" & vbNullChar & _
              "Visual Basic Modules" & vbNullChar & "*.bas" & vbNullChar & _
              "Visual Basic Projects" & vbNullChar & "*.vbp" & vbNullChar & _
              "Text Files" & vbNullChar & "*.txt" & vbNullChar & _
              "All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar
 
 
   With OFN
   
      'size of the OFN structure
      .nStructSize = Len(OFN)
      
      'window owning the dialog
      .hWndOwner = Form1.hWnd
      
      'filters (patterns) for the dropdown combo
      .sFilter = sFilters
      
      'index to the initial filter
      .nFilterIndex = 2
      
      'default filename, plus additional padding
      'for the user's final selection(s). Must be
      'double-null terminated
      .sFile = "Untitled.bas" & Space$(1024) & vbNullChar & vbNullChar
      
      'the size of the buffer
      .nMaxFile = Len(.sFile)
      
      'default extension applied to
      'file if it has no extention
      .sDefFileExt = "bas" & vbNullChar & vbNullChar
                                     
      'space for the file title if a single selection
      'made, double-null terminated, and its size
      .sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
      .nMaxTitle = Len(OFN.sFileTitle)
      
      'starting folder, double-null terminated
      .sInitialDir = "d:\vb5" & vbNullChar & vbNullChar
      
      'the dialog title
      .sDialogTitle = "VBnet GetOpenFileName Demo"
      
      'default open flags and multiselect
      .flags = OFS_FILE_OPEN_FLAGS Or _
               OFN_ALLOWMULTISELECT 
   End With
   
   
  'call the API
   If GetOpenFileName(OFN) Then
    
     'remove trailing pair of terminating nulls
     'and trim returned file string
      buff = Trim$(Left$(OFN.sFile, Len(OFN.sFile) - 2))
    
     'show the members of the returned sFile
     'string in the listbox. If multiselect,
     'the first member is the path, and the
     'remaining members are the files under
     'that path selected.
      Do While Len(buff) > 3
      
         List1.AddItem StripDelimitedItem(buff, vbNullChar)
      
      Loop
   
     'see illustration for descriptions
      Text1.Text = OFN.sFile
      Text2.Text = Left$(OFN.sFile, OFN.nFileOffset)
      Text3.Text = Mid$(OFN.sFile, OFN.nFileOffset + 1, _
                   Len(OFN.sFile) - OFN.nFileOffset - 1)
      
     'note the extention and filetitle are not
     'returned in when in multiselect mode
      Text4.Text = Mid$(OFN.sFile, OFN.nFileExtension + 1, _
                        Len(OFN.sFile) - OFN.nFileExtension)
      Text5.Text = OFN.sFileTitle
      
      sLongname = OFN.sFileTitle
      sShortname = Space$(128)
      pos = GetShortPathName(sLongname, sShortname, Len(sShortname))
      Text6.Text = LCase$(Left$(sShortname, pos))
     
      sLongname = OFN.sFile
      sShortname = Space$(128)
      pos = GetShortPathName(sLongname, sShortname, Len(sShortname))
      Text7.Text = LCase$(Left$(sShortname, pos))
  
      Check1.Value = Abs((OFN.flags And OFN_READONLY))
  
  End If

End Sub


Private Function StripDelimitedItem(startStrg As String, _
                                    delimiter As String) As String

  'take a string separated by nulls,
  'split off 1 item, and shorten the string
  'so the next item is ready for removal.
   Dim pos As Long
   Dim item As String
   
   pos = InStr(1, startStrg, delimiter)
   
   If pos Then

      StripDelimitedItem = Mid$(startStrg, 1, pos)
      startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
    
   End If

End Function


Private Function TrimNull(item As String) As String

   Dim pos As Integer
   
   pos = InStr(item, Chr$(0))
   If pos Then
      TrimNull = Left$(item, pos - 1)
   Else
      TrimNull = item
   End If
  
End Function