Macro to automatically save document with cell reference as filena

[Erich]

I have tried to create a workbook that automatically grabs the filename and
saves the document with some problems

Both methods appear to work, but Excel always crashes. There should be a
way to accomplish this without a crash.

Method 1:

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

Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders
ActiveWorkbook.SaveAs objFolders("mydocuments") & "\Workflow Moves\" &
Sheets("Sheet1").Range("F1").Value & ".xls"
End Sub


Method 2:

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

MyDocsPath = Environ$("USERPROFILE") & "\My Documents\Workflow Moves\"
ActiveWorkbook.SaveAs MyDocsPath & Sheets("Sheet1").Range("F1").Value &
".xls"

End Sub



The bottom line is that when a user saves the file, the file should end up
in a folder called "Workflow Moves" which is in each user's "My Documents"
location and the name should be the value of cel F1 plus the XLS extension.

I'm using Office 2003. I would like for this to work in 2007 as well.

Any help?

Thanks in advance

Erich

 

[Bernie Deitrick]

Erich,

You need to disable events, save the workbook under the new name, and cancel the first
user-initiated save: Excel crashes because it gets into an infinite loop of BeforeSave events.

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

Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders
Application.EnableEvents = False
ActiveWorkbook.SaveAs objFolders("mydocuments") & "\Workflow Moves\" &
Sheets("Sheet1").Range("F1").Value & ".xls"
Application.EnableEvents = True
Cancel = True

End Sub



HTH,
Bernie
MS Excel MVP