Saving cell ref file in cell ref folder

[JamieDuncan]

Im trying to create a macro that saves a file as a cell reference.
Also I want that file to be saved in a folder named after another cell reference.
And I want this folder to be created if it doesnt exist.

So for example i wish to run macro
msgbox appears, do you want to save as O:\Internal\Test\ *folder ref here* \ * file ref here*
and on clicking yes it does exactly that.

Unfortunately i dont know how to aim the file into the folder, any help would be most appreciated

Here is my code so far:

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> SaveSheet()
<SPAN style="color:#007F00">'error trap</SPAN>
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Etrap

<SPAN style="color:#00007F">Dim</SPAN> fname1
fname1 = Sheets("sheet1").Range("a1").Value
<SPAN style="color:#00007F">Dim</SPAN> fname2
fname2 = Sheets("sheet1").Range("a2").Value
<SPAN style="color:#00007F">Dim</SPAN> FilDir
FilDir = "O:\Internal\Test\"
<SPAN style="color:#007F00">'ask user to save</SPAN>
<SPAN style="color:#00007F">If</SPAN> MsgBox("Save new form as " & FilDir & fname2 & ".xls?", vbYesNo) = vbNo <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>

<SPAN style="color:#007F00">'check value of activecell</SPAN>
<SPAN style="color:#00007F">If</SPAN> fname2 = "" <SPAN style="color:#00007F">Then</SPAN>
MsgBox "Please enter reference number", vbInformation
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>

<SPAN style="color:#007F00">'copy activesheet to new workbook</SPAN>
Sheets("Sheet1").Copy

Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#007F00">'create destination directory if it doesnt already exist</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> FilePath, fs
FilePath = "O:\Internal\Test\"
<SPAN style="color:#00007F">Set</SPAN> fs = CreateObject("Scripting.FileSystemObject")
fs.createfolder (FilePath & fname2)

<SPAN style="color:#007F00">'save activebook as new workbook</SPAN>
ActiveWorkbook.SaveAs Filename:=fname1 & ".xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

<SPAN style="color:#007F00">'close new workbook ie. sheet just saved</SPAN>
ActiveWorkbook.Close
Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN>

Etrap:

Beep
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

 

[JamieDuncan]

Any tips? ideas? full code ? i am truly stumped over this one, and i cant find what i need anywhere.

 

[JamieDuncan]

Now now one at a time please :P still no ideas? oh well, ill just have to have a small rant to bump my post :D
ive not been working in an office long, 2 months in fact, and im only 22, moved all the way from devon into the big smoke, YAY, its what i always wanted. I always been at home with computers but now im getting the hang of vba and excel its been noticed by several directors at my company and now i have to go to another office to further develop my programs and intergrate them with access............its quite scary when i think about it.
well now you know a bit more about me and my rant is complete. hehe

 

[Norie]

Jamie

What's your actual question?

What do fname1 and fname2 actually contain?

The filename or the directory?

If you want to check for the existence of a directory you can use Dir.

Dim strPath As String

    strPath = "C:\MyDir\"
    If Dir(strPath, vbDirectory)<>"" Then
       Msgbox "Directory exists."
    Else
       Msgbox "Directory doesn't exist."
    End If

 

[JamieDuncan]

Oops, i see what ive done there,

this line should read this

'ask user to save
If MsgBox("Save new form as " & FilDir & fname2 & "\" & fname1 & ".xls?", vbYesNo) = vbNo Then
Exit Sub
End If

fname1 is the cell ref for the file to be created
fname2 is the cell ref for the directory to be created(if not already there) and saved in

 

[JamieDuncan]

AHAH! ive just found where the file has been going.

The folder is being created in the right place but the file is being saved in my documents :P so what do I need to add to aim the file at the destination folder?

 

[Norie]

Jamie

You need to add the path when you do the SaveAs.

If you don't then the file will be saved to the current directory.

 

[JamieDuncan]

Thanks Norie,
Justed edited these lines and PRESTO! works great,
thanks for your help!

'create destination directory if it doesnt already exist
Dim FilePath, fs
FilePath = "O:\Internal\Test\"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.createfolder (FilePath & fname2)

Dim NewFilePath As String
NewFilePath = FilePath & fname2 & "\"

'save activebook as new workbook
ActiveWorkbook.SaveAs (NewFilePath & fname1 & ".xls"), _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

 

[Norie]

Jamie

Glad to see you got it working.

By the way why not just use MkDir to create the directory?

 

[JamieDuncan]

AARRGGHH!!

Ok for some reason it did work now it stops after it copies the active sheet!?!
I cant see what the problem is which probably means its staring me in the face

Sub SaveSheet()
'error trap
On Error GoTo Etrap

Dim filname
filname = Sheets("sheet1").Range("a1").Value
Dim foldname
foldname = Sheets("sheet1").Range("a2").Value
Dim FilDir, fs
FilDir = "O:\Internal\Test\"
'ask user to save
If MsgBox("Save new form as " & FilDir & foldname & "\" & filname & ".xls?", vbYesNo) = vbNo Then
Exit Sub
End If

'check value of activecell
If foldname = "" Then
MsgBox "Please enter reference number", vbInformation
Exit Sub
End If

'copy activesheet to new workbook
Sheets("Sheet1").Copy
Application.DisplayAlerts = False

'create destination directory if it doesnt already exist
Dim strPath As String
    strPath = FilDir
    If Dir(strPath, vbDirectory) <> "" Then
        GoTo SaveFile
    Else
        Set fs = CreateObject("Scripting.FileSystemObject")
        fs.createfolder (FilDir & foldname)
    End If

SaveFile:
Dim NewFilePath As String
NewFilePath = FilDir & foldname & "\"

'save activebook as new workbook
ActiveWorkbook.SaveAs (NewFilePath & filname & ".xls"), _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

'close new workbook ie. sheet just saved
ActiveWorkbook.Close
Application.DisplayAlerts = True

Etrap:
Beep
Exit Sub

oh and i cleaned it up a little, so its a little easier to understand, i think!