home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / msword1a / filedlgs.bas < prev    next >
Encoding:
BASIC Source File  |  1999-08-27  |  2.7 KB  |  87 lines
  1. Attribute VB_Name = "FileDlgs"
  2. Option Explicit
  3. ' FileDlgs (Vb6) Feb, 1999  contact markb@orionstudios.com
  4. ' Common dialog file routines
  5. ' Requires Project/References to "Microsoft Dialog Automation Objects" (DlgObjs.dll)
  6. '   (If not shown in list, use "Browse"; may be in "PDWizard" directory)
  7. '   DlgObjs.dll is essentially a library version of the Common Dialog Control.
  8. '===================================================================================
  9. Private Const SLOSH = "\"
  10.  
  11. Public Function GetOpenFileName( _
  12.                     StartDir As String, _
  13.                     ParamArray Masks() As Variant) As String
  14.  
  15.     On Error GoTo GetOpenFileName_Error
  16.     
  17.     Dim Result As String        ' Default function result = ""
  18.     Dim Dlg As DialogObjects.ChooseFile
  19.     Dim RestoreCurDir As String ' Restore current dir on exit
  20.     Dim Filter As Variant
  21.     
  22.     RestoreCurDir = CurDir
  23.     Set Dlg = New DialogObjects.ChooseFile
  24.     With Dlg
  25.         If Len(StartDir) Then .Directory = StartDir
  26.         For Each Filter In Masks
  27.             .Filters.Add Filter
  28.         Next
  29.         .Center = True
  30.         .FileMustExist = True
  31.         .HideReadOnly = False
  32.         .Show
  33.         If Len(.FileName) Then Result = .Directory & SLOSH & .FileName
  34.     End With
  35.     
  36. GetOpenFileName_Exit:
  37.     Set Dlg = Nothing
  38.     ChDir RestoreCurDir
  39.     GetOpenFileName = Result
  40.     Exit Function
  41.     
  42. GetOpenFileName_Error:
  43.     MsgBox Err.Message & " - " & Err.Description, vbExclamation, "GetOpenFileName"
  44.     Resume GetOpenFileName_Exit
  45.     
  46. End Function
  47.  
  48. Public Function GetSaveAsFileName( _
  49.                     DefaultFileName As String, _
  50.                     StartDir As String, _
  51.                     ParamArray Masks() As Variant) As String
  52.  
  53.     On Error GoTo GetSaveAsFileName_Error
  54.     
  55.     Dim Result As String        ' Default function result = ""
  56.     Dim Dlg As DialogObjects.ChooseFile
  57.     Dim RestoreCurDir As String ' Restore current dir on exit
  58.     Dim Filter As Variant
  59.     
  60.     RestoreCurDir = CurDir
  61.     Set Dlg = New DialogObjects.ChooseFile
  62.     With Dlg
  63.         If Len(StartDir) Then .Directory = StartDir
  64.         For Each Filter In Masks
  65.             .Filters.Add Filter
  66.         Next
  67.         .FileName = DefaultFileName
  68.         .Center = True
  69.         .Save = True
  70.         .OverwritePrompt = True
  71.         .HideReadOnly = True
  72.         .Show
  73.         If Len(.FileName) Then Result = .Directory & SLOSH & .FileName
  74.     End With
  75.     
  76. GetSaveAsFileName_Exit:
  77.     Set Dlg = Nothing
  78.     ChDir RestoreCurDir
  79.     GetSaveAsFileName = Result
  80.     Exit Function
  81.     
  82. GetSaveAsFileName_Error:
  83.     MsgBox Err.Message & " - " & Err.Description, vbExclamation, "GetSaveAsFileName"
  84.     Resume GetSaveAsFileName_Exit
  85.     
  86. End Function
  87.