VB and VBA Users Source Code: Show the "Save File" Common Dialog
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Show the "Save File" Common Dialog
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, November 17, 2000
Hits:
972
Category:
Windows API
Article:
The following code shows how to use API calls to show the "save as" common dialog (demo code can be found at the bottom of the post): Option Explicit Private Declare Function GetSaveFileNameA Lib "comdlg32.dll" (pOpenfilename As OPENFILENAME) As Long Private Declare Function GetActiveWindow Lib "user32" () As Long Private 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 Function ShowSaveAsDialog(Optional sTitle = "Save File", Optional sFilter As String, Optional sDefaultDir As String) As String Const clBufferLen As Long = 255 Dim OFName As OPENFILENAME, sBuffer As String * clBufferLen On Error GoTo ExitFunction OFName.lStructSize = Len(OFName) OFName.hwndOwner = GetActiveWindow 'or Me.hwnd in VB OFName.hInstance = 0 'or App.hInstance in VB If Len(sFilter) Then OFName.lpstrFilter = sFilter Else OFName.lpstrFilter = "Text Files (*.txt)" & Chr$(0) & "*.txt" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*" & Chr$(0) End If OFName.lpstrFile = sBuffer OFName.nMaxFile = clBufferLen 'Set max number of characters OFName.lpstrFileTitle = sBuffer OFName.nMaxFileTitle = clBufferLen 'Set max number of characters 'Set the initial directory If Len(sDefaultDir) Then OFName.lpstrInitialDir = sDefaultDir Else OFName.lpstrInitialDir = CurDir$ End If OFName.lpstrTitle = sTitle OFName.flags = 0 'Show dialog If GetSaveFileNameA(OFName) Then ShowSaveAsDialog = Left$(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) - 1) Else ShowSaveAsDialog = "" End If ExitFunction: Debug.Print "Error in ShowSaveAsDialog. Error: " & Err.Description Debug.Assert False On Error GoTo 0 End Function 'Demostration routine Sub Test() Dim sFilePath As String sFilePath = ShowSaveAsDialog("Save workbook file", "*.xls", "C:\Program Files\") MsgBox "File to save " & sFilePath End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
