J
Joy
How can I write a macro to pop up File SaveAs dialog?
I find some codes online. Now the codes runs well except only one issue: the
Save As Type
The Save As type is "Project (.mpp)". If user uses 2007 version, and he/she
wants to save as 2003 format, this doe not help.
My question is: how can I list a list of file type for user to choose (like
(MS Project 2000-2003, Project, ...)) instead of only one type?
the codes:
' ---------------------------------------------------------------------
' Win32 API declarations so that VBA can call
' Windows functions directly
' ---------------------------------------------------------------------
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
' ---------------------------------------------------------------------
' Win32 API structure definition as user-defined type
' ---------------------------------------------------------------------
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
Dim dgnFile As String
dgnFile = ShowSave ("Save Design File As...", "Microstation Files (*.dgn)",
"*.dgn", "V:\shared")
' ---------------------------------------------------------------------
' ShowSave Save As... common dialog
' Arguments: [in, String] dialog title,
' [in, String] filter description, [optional]
' [in, String] filter spec, [optional]
' [in, String] default directory [optional]
' Example call:
' dgnFile = ShowSave ("Save Design File As...", "Microstation Files
(*.dgn)", "*.dgn", "V:\shared")
' Returns: full path of file to be saved
' ---------------------------------------------------------------------
Public Function ShowSave( _
ByVal strDialogTitle As String, _
ByVal strProposed As String, _
Optional ByVal strFilterDescr As String = "All files (*.*)", _
Optional ByVal strFilterSpec As String = "*.*", _
Optional ByVal strDefaultDir As String = vbNullString) As String
On Error Resume Next
Dim strFilter As String, _
strFileSelected As String, _
proposed As String
Dim OFName As OPENFILENAME
strFilter = strFilterDescr + Chr$(0) + strFilterSpec + Chr$(0)
proposed = strProposed & Chr$(0) & Space$(254 - Len(strProposed))
'Create a buffer
Const Period As String = "."
With OFName
.lStructSize = Len(OFName) 'Set the structure size
.hWndOwner = 0& 'Set the owner window
.hInstance = 0& 'Set the application's instance
.lpstrFilter = strFilter 'Set the filter
.lpstrFile = proposed
'.lpstrDefExt = Space$(Len(strFilterSpec))
.lpstrDefExt = Mid$(strFilterSpec, 1 + InStr(strFilterSpec, Period))
.nMaxFile = 255 'Set the maximum number of chars
.lpstrFileTitle = Space$(254) 'Create a buffer
.nMaxFileTitle = 255 'Set the maximum number of chars
If (vbNullString <> strDefaultDir) Then _
.lpstrInitialDir = strDefaultDir 'Set the initial directory
.lpstrTitle = strDialogTitle 'Set the dialog title
.flags = OFN_OVERWRITEPROMPT 'no extra flags
End With
If GetSaveFileName(OFName) Then 'Show the 'Save File' dialog
strFileSelected = Trim$(OFName.lpstrFile)
If (InStr(strFileSelected, Chr(0)) > 0) Then
strFileSelected = Left(strFileSelected, InStr(strFileSelected,
Chr(0)) - 1)
End If
ShowSave = Trim(strFileSelected)
Else
ShowSave = ""
End If
End Function
http://www.la-solutions.co.uk/content/MVBA/MVBA-CommonDialogs.htm
Thanks.
I find some codes online. Now the codes runs well except only one issue: the
Save As Type
The Save As type is "Project (.mpp)". If user uses 2007 version, and he/she
wants to save as 2003 format, this doe not help.
My question is: how can I list a list of file type for user to choose (like
(MS Project 2000-2003, Project, ...)) instead of only one type?
the codes:
' ---------------------------------------------------------------------
' Win32 API declarations so that VBA can call
' Windows functions directly
' ---------------------------------------------------------------------
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
' ---------------------------------------------------------------------
' Win32 API structure definition as user-defined type
' ---------------------------------------------------------------------
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
Dim dgnFile As String
dgnFile = ShowSave ("Save Design File As...", "Microstation Files (*.dgn)",
"*.dgn", "V:\shared")
' ---------------------------------------------------------------------
' ShowSave Save As... common dialog
' Arguments: [in, String] dialog title,
' [in, String] filter description, [optional]
' [in, String] filter spec, [optional]
' [in, String] default directory [optional]
' Example call:
' dgnFile = ShowSave ("Save Design File As...", "Microstation Files
(*.dgn)", "*.dgn", "V:\shared")
' Returns: full path of file to be saved
' ---------------------------------------------------------------------
Public Function ShowSave( _
ByVal strDialogTitle As String, _
ByVal strProposed As String, _
Optional ByVal strFilterDescr As String = "All files (*.*)", _
Optional ByVal strFilterSpec As String = "*.*", _
Optional ByVal strDefaultDir As String = vbNullString) As String
On Error Resume Next
Dim strFilter As String, _
strFileSelected As String, _
proposed As String
Dim OFName As OPENFILENAME
strFilter = strFilterDescr + Chr$(0) + strFilterSpec + Chr$(0)
proposed = strProposed & Chr$(0) & Space$(254 - Len(strProposed))
'Create a buffer
Const Period As String = "."
With OFName
.lStructSize = Len(OFName) 'Set the structure size
.hWndOwner = 0& 'Set the owner window
.hInstance = 0& 'Set the application's instance
.lpstrFilter = strFilter 'Set the filter
.lpstrFile = proposed
'.lpstrDefExt = Space$(Len(strFilterSpec))
.lpstrDefExt = Mid$(strFilterSpec, 1 + InStr(strFilterSpec, Period))
.nMaxFile = 255 'Set the maximum number of chars
.lpstrFileTitle = Space$(254) 'Create a buffer
.nMaxFileTitle = 255 'Set the maximum number of chars
If (vbNullString <> strDefaultDir) Then _
.lpstrInitialDir = strDefaultDir 'Set the initial directory
.lpstrTitle = strDialogTitle 'Set the dialog title
.flags = OFN_OVERWRITEPROMPT 'no extra flags
End With
If GetSaveFileName(OFName) Then 'Show the 'Save File' dialog
strFileSelected = Trim$(OFName.lpstrFile)
If (InStr(strFileSelected, Chr(0)) > 0) Then
strFileSelected = Left(strFileSelected, InStr(strFileSelected,
Chr(0)) - 1)
End If
ShowSave = Trim(strFileSelected)
Else
ShowSave = ""
End If
End Function
http://www.la-solutions.co.uk/content/MVBA/MVBA-CommonDialogs.htm
Thanks.