Detecting change in Save As filename before hitting OK

Lassebasse · Feb 21, 2018

Hi everyone,

Maybe a cryptic Title but I'll explain:

I Use "Application.Dialogs(xlDialogSaveAs).Show(filename)" (containing prompted filename) to open Dialog window Save As.
Now, I want to detect if that filename in an way is changed before hitting "OK" to save (actually I want to prevent/stop any change of the filename).

Can I lock the filename to the prompted one, or at least exit code if any change is made to the filename before hitting "OK"?

Thank you in advance!

Regards
lassebasse

Jaafar Tribak · Feb 22, 2018

I rmemember doing this some time ago.. I disbaled the filename edit control and cleared the file name dropdown so the user could only set the save folder but not change the initial filename.

I achieved this by subclassing the xlDialogSaveAs so the code is rather involved .. If you are interested I can post the working code here later.

Youngdand · Feb 22, 2018

IT shouldn't make a difference, on save, it would used the correct filename therefore would not enter the loop and if saveas and they use the correct filename it would not enter the loop, only if the filename was not as specified by you in newfname would it enter the loop, and save as the correct filename.

The file deletion i am struggling with, as once the file is saved, the full path of thisworkbook is updated, and when i run the kill it tries to delete the current file, which i locked.

I will keep at it. im sure it can be done.

my VBA is not fantastic, so maybe someone else has a decent idea how to kill the file saved with the incorrect name.

Regards,

Dan.

Jaafar Tribak · Feb 22, 2018

Also you could try using GetSaveAsFilename and check the new filename in the return value against the current filename.

Jaafar Tribak · Feb 22, 2018

Add this code to a new Standard Module :

Code:

Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    
    Dim lHook As LongPtr, lPrevProc As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    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
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
    Dim lHook As Long, lPrevProc As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Const WH_CBT = 5
Const HCBT_ACTIVATE = 5
Const GWL_WNDPROC = (-4)
Const EM_SETREADONLY = &HCF
Const WM_DESTROY = &H2
Const CB_GETCOUNT = &H146
Const CB_GETDROPPEDSTATE = &H157
Const CB_DELETESTRING = &H144
Const CB_SETITEMDATA = &H151

Property Let LockDialogFileName(ByVal vNewValue As Boolean)
    If vNewValue Then
        lHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
    End If
End Property

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
     Dim hwnd As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Dim hwnd As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim ret As Long, sClassName As String
    If idHook Then
        Select Case idHook
            Case HCBT_ACTIVATE
                sClassName = Space$(256)
                ret = GetClassName(wParam, ByVal sClassName, 256)
                sClassName = Left$(sClassName, ret)
                If sClassName = "#32770" Then
                    UnhookWindowsHookEx lHook
                    hwnd = FindWindowEx(wParam, 0&, "DUIViewWndClassName", vbNullString)
                    hwnd = FindWindowEx(hwnd, 0&, "DirectUIHWND", vbNullString)
                    hwnd = FindWindowEx(hwnd, 0, "FloatNotifySink", vbNullString)
                    hwnd = FindWindowEx(hwnd, 0, vbNullString, vbNullString)
                    lPrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WinProc)
                    hwnd = FindWindowEx(hwnd, 0, vbNullString, vbNullString)
                    Call SendMessage(hwnd, EM_SETREADONLY, True, ByVal 0)
                End If
        End Select
    End If
    HookProc = CallNextHookEx(lHook, idHook, wParam, ByVal lParam)
End Function

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Function WinProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Function WinProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim i As Long
    Select Case uMsg
        Case CB_SETITEMDATA
            For i = 0 To CLng(SendMessage(hwnd, CB_GETCOUNT, 0, ByVal 0))
                Call SendMessage(hwnd, CB_DELETESTRING, i, ByVal 0)
            Next i
            Exit Function
        Case CB_GETDROPPEDSTATE
            WinProc = -1
            Exit Function
        Case WM_DESTROY
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevProc)
    End Select
    WinProc = CallWindowProc(lPrevProc, hwnd, uMsg, wParam, lParam)
End Function

Code usage demo :

Code:

Sub Start()
    LockDialogFileName = True
    If Application.Dialogs(xlDialogSaveAs).Show("Filename") Then
        MsgBox "File Saved Successfully !"
    End If
End Sub

Lassebasse · Feb 23, 2018

Jaafar:
Thanks for your replies even though your code seems to be way over my head. I have tried “Get SaveAsFilename” but I didn’t quite get it to work the way I want to.
But; how do I “check the filename in the return value against the correct filename, using “Get SaveAsFilename”?)

I’d like to look more into Youngdand’s code.

Youngdand:
If I understand correct, you’re still working on getting the file deletion to work (Thank you). I’m crossing my fingers …
As I asked earlier, if you don’t delete the wrongly named file, in this moment there are 2 files in the chosen folder; 1 named correctly and 1 named wrongly?

This is about a SaveAs dialog. In that there are a lot of arguments (really many). But there name only says “arg1”, “arg2” and so on.
What are all of those for? Not even 1 could be used to lock the filename in the dialogbox?

)

… or maybe it’s easier to just tell the users not to change the prompted filename …

)

/Lassebasse

Lassebasse · Feb 23, 2018

I found this online, Application.FileDialog(msoFileDialogFolderPicker), https://answers.microsoft.com/en-us...lows-for/90a96bd1-caf3-46f4-84af-3c91b7223f55, where the user only choose destination folder.
Filename i previously set, the way I want it to be.

I started with the original code below and suited it for my needs, which seems to work:

Code:

Dim fPath
Dim fName
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
fPath = .SelectedItems(1) & "\"
fName = fPath & Range("B21").Value & ".xlsm"
Call MsgBox(fName, vbInformation, "Save Path")
ThisWorkbook.SaveAs Filename:=fName, [B]FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False[/B]
End If
End With
End Sub

Youngdand · Feb 26, 2018

Lassebasse said:
Youngdand:
If I understand correct, you’re still working on getting the file deletion to work (Thank you). I’m crossing my fingers …
As I asked earlier, if you don’t delete the wrongly named file, in this moment there are 2 files in the chosen folder; 1 named correctly and 1 named wrongly?

/Lassebasse

Thats correct, there will be 2 files, however, regardless of which one they update, the next time they save it, it will overwite the file you want with he correct name.

I have been away for a couple of days, so have a bit of work to catch up on, but will try and have a look later. i have a couple of ideas, 1 where i will close the file and rename it instead of saving as, or 1 where i store the filename they save as in a new sheet, then use this to delete the file after the loop. i will give them a try later and see which one works best.

Regards,

Dan.

Lassebasse · Feb 26, 2018

Hi Dan,

You seem like an expert in this area, though your code/explanation feels a bit tricky.

Code:

[FONT='inherit']Dim fPath[/FONT]

  [FONT='inherit']Dim fName[/FONT]

  [FONT='inherit']With Application.FileDialog(msoFileDialogFolderPicker)[/FONT]

  [FONT='inherit']If .Show = True Then[/FONT]

  [FONT='inherit']fPath = .SelectedItems(1) & ""[/FONT]

  [FONT='inherit']fName = fPath & Range("B21").Value & ".xlsm"[/FONT]
  [FONT='inherit']Call MsgBox(fName, vbInformation, "Save Path")[/FONT]
  [FONT='inherit']ThisWorkbook.SaveAs Filename:=fName, [B]FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False[/B][/FONT]
  [FONT='inherit']End If[/FONT]
  [FONT='inherit']End With[/FONT]

  [FONT='inherit']End Sub[/FONT]

As I wrote earlier; I used the code above, after some adjustments, and it seems to work well.
The code sets filename in advance, and the user can only choose destination folder.

This code, as I’ve made it now, seems quite simple, but still functional. Do you think this code could be bad in any way?

Regards
/Lassebasse

Youngdand · Feb 26, 2018

HI,
Your code works fine, How are you triggering this macro? Your code does not hook in to the save as routine, so people can still save the file as whatever they like using the conventional save as method.

IF this is what you want that's great.

My knowledge is not great, but i like problem solving!

the only thing i can see that may cause you issues, is if the value of b21 gets changed. you could just hardcode the filename in place to make it more robust.

However as per above, this does not prohibit the users just using the conventional saveas option from the file menu, and calling the file whatever they like.

Regards,

Dan.

Lassebasse · Feb 26, 2018

Hi Dan,
Thanks for your answer.

This is triggered from a button I’ve put in a sheet.

In “Workbook_Open” I have done this:

(No, hopefully they CANNOT Save As …)

If a user tries to save the workbook, they get a message: “You cannot save this file.”

If they try to “Save As” (normally), they are redirected to my code using “Call codename”; (If notMyUsername And SaveAsUI Then Call code BlaBlaBla … ).

(these 2 alternatives are conditioned on username not being me (I should be able to do everything).

Did this make any sense?

Concerning “B21”: this is one of the things I have changed from the original code I found online.

My code builds the filename automatically (a string + username), which the user can do nothing about.

With this I think I’ve covered it all!

Regards
/Lassebasse

Detecting change in Save As filename before hitting OK

Lassebasse

New Member

Jaafar Tribak

Well-known Member

Excel Facts

Youngdand

Board Regular

Jaafar Tribak

Well-known Member

Jaafar Tribak

Well-known Member

Lassebasse

New Member

Lassebasse

New Member

Youngdand

Board Regular

Lassebasse

New Member

Youngdand

Board Regular

Lassebasse

New Member

Similar threads

Forum statistics

Share this page

Detecting change in Save As filename before hitting OK

New Member

Well-known Member

Excel Facts

Board Regular

Well-known Member

Well-known Member

New Member

New Member

Board Regular

New Member

Board Regular

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock