Visual Basic Programming Code Examples

Show the 'Save File' Common Dialog To show the save file common dialog use the following code: 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 SaveAsCommonDialog(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 SaveAsCommonDialog = Left$(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) - 1) Else SaveAsCommonDialog = "" End If ExitFunction: On Error GoTo 0 End Function 'Demostration routine Sub Test() Dim sFilePath As String sFilePath = SaveAsCommonDialog("Save workbook file", "*.xls", "C:\Program Files\") MsgBox "File to save " & sFilePath End Sub