Automate Filename on 'Save As'

[Cadnium]

Hi All,

I have just spent an hour an a half trying to get this to work with no luck.

I have a read only file which I want to automatically name when the person using it goes to save it. The filename has been automated in 'Sheet4' cell "F5". I can get the VBA code to work at time, but I cannot get it to trigger when you go to save the sheet using the normal 'Save' or 'Save As' commands.

I already have a bit of VBA code in the document so I was not sure on how to write or trigger this part.

Any help would be greatly appreciated.

Cheers,

Cadnium

 

[VoG]

Try like this in the ThisWorkbook module

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
'
'your code here
'
Application.EnableEvents = True
End Sub

 

[Cadnium]

Hey VoG,

Thanks for your help but I am obviously just not getting it... sorry, I am new to VBA!

I tried the two following things based on other websites and your advice but I still cannot get the 'Save As' dialog box to pre-fill with any custom text... it just comes up with the existing sheet name.

To make it simpler I tried to just choose the cell 'F5' in the current workbook but in reality I want it to default to Shee4 regardless of which sheet they are in when they save.


Code (in ThisWorkbook)
-----------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
'
ActiveWorkbook.SaveAs Filename:=Range("F5").Value
'
Application.EnableEvents = True
End Sub


Private Sub SaveTrial()
Application.Dialogs(xlDialogSaveAs).Show Range("F5").Value
End Sub
-------------------------

 

[Cadnium]

Hi,

Just to clarify - I don't really want a macro based on a specialised button,


I want the person using the sheet to simply go to File>Save or File>Save As and then the text that comes up in the pop-up is pre-filled based on the data in Cell F5 in worksheet Sheet4.

Thanks in advance,

Cadnium

 

[Jaafar Tribak]

Which version of excel do you have ?

 

[VoG]

This should run automatically when they Save or Save As

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
'
ActiveWorkbook.SaveAs Filename:=Sheets("Sheet4").Range("F5").Value
'
Application.EnableEvents = True
End Sub

 

[Cadnium]

Hey guys,

Thanks for the help. I still didn't quite get it working how I wanted, not sure why. The suggestion by VoG certainly works, but once triggered it auto saves into the default directory. I wanted to have the dialog box box come up and just pre-fill the string without forcing the user to use that name or that directory.

I think I am trying to be too smart for my own good so I think I might just leave things as is.....

Thanks for the help though.

Cheers,

Cadnium

 

[Jaafar Tribak]

This can certainly be done- I did it before.

1- Add a new standard module to your project and put the following code in it :

Option Explicit
 
Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
 
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
 
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
 
Private Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
 
Private Declare Function SendMessage Lib "user32.dll" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
 
 
Private Const GWL_HINSTANCE As Long = (-6)
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private Const WM_SETTEXT As Long = &HC
 
Private lCBTHook  As Long
Private sFileName As String


Public Sub SetDefaultFileName(ByVal FileName As String)

    'store the default file name.
    sFileName = FileName
    'monitor the SaveAs Dlg window.
    lCBTHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, _
    GetAppInstance, GetCurrentThreadId)

End Sub



Private Function CBTProc _
(ByVal idHook As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
    Dim sBuffer As String
    Dim lRetVal As Long
    Dim lFileNameFieldHwnd As Long
 
 
    Select Case idHook
    
    Case Is = HCBT_ACTIVATE 'did a window get activated ?
    
        'if so,is it our SaveAs wnd ?
        sBuffer = Space(256)
        lRetVal = GetClassName(wParam, sBuffer, 256)
        
        If Left(sBuffer, lRetVal) = "bosa_sdm_XL9" Then
        'it's our SaveAs wnd so remove the CBT hook now.
        UnhookWindowsHookEx lCBTHook
        
        'retrieve the FileName box hwnd.
        lFileNameFieldHwnd = _
        FindWindowEx(wParam, 0, "RichEdit20W", vbNullString)
        lFileNameFieldHwnd = _
        FindWindowEx(wParam, lFileNameFieldHwnd, "RichEdit20W", vbNullString)
        
        If lFileNameFieldHwnd Then
            'change the filename box default text.
            SendMessage lFileNameFieldHwnd, WM_SETTEXT, ByVal 0, ByVal sFileName
        End If
        
        End If
    
    End Select
 
    CBTProc = CallNextHookEx _
    (lCBTHook, idHook, ByVal wParam, ByVal lParam)
 
End Function


Private Function GetAppInstance() As Long
 
    GetAppInstance = GetWindowLong _
    (FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
 
End Function

2- Put the following code in the Workbook module :

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    If SaveAsUI Then
        SetDefaultFileName FileName:=Range("F5").Value
    End If

End Sub

EDIT :

Tested on Excel 2007 only. the code may need to be amended for other excel versions.

 

[Jon Peltier]

Probably a lot easier to use GetSaveAsFileName (see Get Open Or Save-As FileName), and you won't have to rewrite the Windows APIs for 64-bit Excel 2010.

 

[lawre2000]

Attachment Macro

Hello, I am attempting to attach a file to an email with a macro and am currently using:

.Attachments.Add ("H:\PALMERL\Power Report Test.xls")

Is there a way to reference the file name from a cell but keeping the same directory? Thanks