creating a folder and saving in it with a filename taken from cell

[ditto]

I would like excel to create the folder C:/Bill if it doesn't already exist when I click save/save as option and save the workbook in it with a filename that is a combination of text/values in cells A1 and A2 on Sheet1. Better if the save as dialog box appears with this option selected so that I have to just click Save in the save as dialog box to save it in "C:/Bill". Please help. <!-- / message --><!-- BEGIN TEMPLATE: ad_showthread_firstpost_sig --><!-- END TEMPLATE: ad_showthread_firstpost_sig -->

<!-- controls -->

 

[VoG]

Hello and welcome to MrExcel.

Try

Function dirExists(dirAndPath) As Boolean
Dim tempVar
On Error Resume Next
tempVar = Dir(dirAndPath & "\*.*", vbDirectory)
If Err = 0 And tempVar <> "" Then
    dirExists = True
End If
On Error GoTo 0
End Function

Sub SaveMe()
Dim fname As String
If Not dirExists("C:\Bill") Then MkDir "C:\Bill"
fname = Sheets("Sheet1").Range("A1").Value & Sheets("Sheet1").Range("A2").Value & ".xls"
ThisWorkbook.SaveAs Filename:="C:\Bill\" & fname
End Sub

 

[ditto]

I am using excel2007.
How do I make this code run when I click save.
Where should I put the code?
I am new to vba that's why.

 

[VoG]

Click the Office button (top left), click Excel Options, tick Show Developer tab in the Ribbon and click OK.

Press ALT + F11 to open the Visual Basic Editor, Insert > Module then paste the following modified code into the white space on the right:

Function dirExists(dirAndPath) As Boolean
Dim tempVar
On Error Resume Next
tempVar = Dir(dirAndPath & "\*.*", vbDirectory)
If Err = 0 And tempVar <> "" Then
    dirExists = True
End If
On Error GoTo 0
End Function

Sub SaveMe()
Dim fname As String
If Not dirExists("C:\Bill") Then MkDir "C:\Bill"
fname = Sheets("Sheet1").Range("A1").Value & Sheets("Sheet1").Range("A2").Value & ".xlsm"
ThisWorkbook.SaveAs Filename:="C:\Bill\" & fname
End Sub

Press ALT + F11 to return to your sheet, on the Developer tab click Macros, highlight SaveMe and click the Run button.

 

[ditto]

But can I attach it to a beforesave event so that I dont have to run the macro manually?

 

[VoG]

In the VBE, View > Project Explorer. Double click ThisWorkbook and paste in the following code

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
Call SaveMe
Application.EnableEvents = True
End Sub

 

[ditto]

Thanks a lot. You are great.

 

[ditto]

If a file by the same filename exists in the folder and when asked whether to replace the file if I click "No" a Runtime error message 1004 appears which says method saveas of object workbook failed. After this error the automatic naming of file works only after closing and reopening the file. Please help me out of this.

 

[VoG]

Try this

Sub SaveMe()
Dim fname As String
If Not dirExists("C:\Bill") Then MkDir "C:\Bill"
fname = Sheets("Sheet1").Range("A1").Value & Sheets("Sheet1").Range("A2").Value & ".xls"
fname = Replace(Replace(fname, "/", "-"), ":", "-")
On Error Resume Next
ThisWorkbook.SaveAs Filename:="C:\Bill\" & fname
On Error GoTo 0
End Sub

 

[ditto]

Now it works fine. Thanks a lot.