Save a file on a particular location Forcefully.
 

Hi all,

I have writen a macro to share and unshare workbook but some time the macro
save the file in my document folder instead of shared folder.

I want a macro(code) which will forcefully saves the workbook on shared
folder. I mean when ever the user try's to use save-as option the defult path
should be of shared folder.

Please help.

Regards
Heera Chavan

Save a file on a particular location Forcefully.
 

You need to trap the SAVEAS function using a before save function. The
use the Shell Dialog function to be able only able to select specific
folders. I can't see to find all the option required. the website
below has all the options for the code beolw. I have to leave for work
now and will continue looking for all the options to only allow certain
folders to be selected.

'OPENFILENAME Structure ()'
(http://msdn.microsoft.com/en-us/libr...39(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 Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=151267

Microsoft Office Help