Macro to automatically save document with cell reference as filena

  • Thread starter Thread starter Erich
  • Start date Start date
E

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
 
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
 
Back
Top