How to show File Save As Dialog using API
Posted on January 4, 2009
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | 'System & API - How to show File Save As Dialog using API Option Explicit 'ShowOpen/ShowSave flags: Public Const OFN_ALLOWMULTISELECT = &H200 Public Const OFN_CREATEPROMPT = &H2000 Public Const OFN_ENABLEHOOK = &H20 Public Const OFN_ENABLETEMPLATE = &H40 Public Const OFN_ENABLETEMPLATEHANDLE = &H80 Public Const OFN_EXPLORER = &H80000 Public Const OFN_EXTENSIONDIFFERENT = &H400 Public Const OFN_FILEMUSTEXIST = &H1000 Public Const OFN_HIDEREADONLY = &H4 Public Const OFN_LONGNAMES = &H200000 Public Const OFN_NOCHANGEDIR = &H8 Public Const OFN_NODEREFERENCELINKS = &H100000 Public Const OFN_NOLONGNAMES = &H40000 Public Const OFN_NONETWORKBUTTON = &H20000 Public Const OFN_NOREADONLYRETURN = &H8000 Public Const OFN_NOTESTFILECREATE = &H10000 Public Const OFN_NOVALIDATE = &H100 Public Const OFN_OVERWRITEPROMPT = &H2 Public Const OFN_PATHMUSTEXIST = &H800 Public Const OFN_READONLY = &H1 Public Const OFN_SHAREAWARE = &H4000 Public Const OFN_SHAREFALLTHROUGH = 2 Public Const OFN_SHARENOWARN = 1 Public Const OFN_SHAREWARN = 0 Public Const OFN_SHOWHELP = &H10 Public Const OFS_MAXPATHNAME = 128 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 Global OFName As OPENFILENAME Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _ (pOpenfilename As OPENFILENAME) As Long 'Use the vbNullChar character to seperate extensions in the filter 'ex: sFilter = "Text Files (*.txt)" + vbNullChar + "*.txt" + "All Files (*.*)" + vbNullChar + "*.*" 'Use the OR operator for multiple flags 'ex: nFlags = OFN_EXPLORER Or OFN_FILEMUSTEXIST Public Function ShowSave(ByVal hWndOwner As Long, ByVal sFilter As String, ByVal sTitle As String, Optional ByVal nFlags As Long = OFN_EXPLORER) As String OFName.lStructSize = Len(OFName) OFName.hWndOwner = hWndOwner OFName.hInstance = App.hInstance OFName.lpstrFilter = sFilter OFName.lpstrFile = String(254, vbNullChar) OFName.nMaxFile = 255 OFName.lpstrFileTitle = String(254, vbNullChar) OFName.nMaxFileTitle = 255 OFName.lpstrTitle = sTitle OFName.flags = nFlags If GetSaveFileName(OFName) Then ShowSave = StripTerminator(OFName.lpstrFile) Else ShowSave = "" End If End Function Private Function StripTerminator(ByVal sInput As String) As String Dim ZeroPos As Integer ZeroPos = InStr(1, sInput, vbNullChar) If ZeroPos > 0 Then StripTerminator = Left$(sInput, ZeroPos - 1) Else StripTerminator = sInput End If End Function |