You need to trap the SAVEAS function using a before save function. Th
use the Shell Dialog function to be able only able to select specifi
folders. I can't see to find all the option required. the websit
below has all the options for the code beolw. I have to leave for wor
now and will continue looking for all the options to only allow certai
folders to be selected.
'OPENFILENAME Structure ()
(
http://msdn.microsoft.com/en-us/library/ms646839(VS.85).aspx)
Put into module
Public Type OPENFILENAME
tLng_StructSize As Long
tLng_hWndOwner As Long
tLng_hInstance As Long
tStr_Filter As String
tStr_CustomFilter As String
tLng_MaxCustFilter As Long
tLng_FilterIndex As Long
tStr_File As String
tLng_MaxFile As Long
tStr_FileTitle As String
tLng_MaxFileTitle As Long
tStr_InitialDir As String
tStr_Title As String
tLng_flags As Long
tInt_FileOffset As Integer
tInt_FileExtension As Integer
tStr_DefExt As String
tLng_CustData As Long
tLng_Hook As Long
tStr_TemplateName As String
End Type
Public Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
pUT INTO THIS WORKBOOK
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
Dim lStr_FileSel As String
Dim fTyp_SaveFileName As OPENFILENAME
'only run when used as SaveAs
If SaveAsUI Then
With fTyp_SaveFileName
.tLng_StructSize = Len(fTyp_SaveFileName)
.tLng_hWndOwner = Application.Hwnd
.tLng_hInstance = Application.Hinstance
.tStr_Filter = "Text Files (*.txt)" & Chr$(0) & _
"*.txt" + Chr$(0) & _
"All Files (*.*)" + Chr$(0) & _
"*.*" + Chr$(0)
.tStr_File = Space$(254)
.tLng_MaxFile = 255
.tStr_FileTitle = Space$(254)
.tLng_MaxFileTitle = 255
.tStr_InitialDir = "C:\temp\"
.tStr_Title = "Select File to Save"
.tLng_flags = 0
End With
If (GetSaveFileName(fTyp_SaveFileName)) Then
lStr_FileSel = Trim(fTyp_SaveFileName.tStr_File)
Else
lStr_FileSel = ""
End If
ThisWorkbook.SaveAs Filename:=lStr_FileSel
End If
'always cancel so another pop up doesn't occur
Cancel = True
End Su
