MACRO - Check/Create Folder Structure And Save

MarkAn

New member
Joined
Oct 23, 2012
Messages
5
Reaction score
0
Points
0
Hi there

I am hoping that someone can please help me, I will try and put this as best I can:

I have an Excel spreadsheet - 3 tabs - TabA, TabB (Hidden) and TabC (Hidden).

The user enters details into a predetermined fields onto TabA, this information is then copied (via formulas) into the hidden sheet TabB, when the user has completed entering in all the information they then click on a button to Save.

The information on TabB is copied into TabC, this tab is then copied into a new workbook and saved as a 1 tab workbook.

The location of where this tab needs to be saved, is compiled in cell CA1, as the destination/file name will be dependant on the information entered. I haved tried a previous Macro to check if the folder structure exists and if it does, then save the file, but if it doesn't then create the folder structure and then also save the file, however, I have hit a bit of a wall.

I tried the coding supplied to me on my home pc and it worked fine - saving to C:\Documents and Settings\Administrator\My Documents etc etc..... however, when I tried it in my workplace, I find I am having difficultly, it is not saving in the folder structure that already exist, it is creating a whole new structure.

The only difference I can see is the path/folder structure, although still wanting to save in "My Documents".

When I right click on the folder it is showing the path that I need, which I entered, as it doesn't have an assigned drive I.e. C:\..... it shows as E.g. \\Dfs60325.gpn.gov.uk\1234567$\My Documents.....

The first part being the location, "1234567$" being the users identifier etc.....

Can anyone please please help me with my dilemma??

Many thanks in advance.

Mark
 
Hi Mark,

Try this peice of code to return the user's home directory:

Code:
[FONT=Courier New][SIZE=2]Environ("USERPROFILE") + "\My Documents"[/SIZE][/FONT]

Let me know if that sorts it for you.
 
You can also use

Code:
CreateObject("WScript.Shell").SpecialFolders("MyDocuments")

There are a whole series of Special Folders.
 
Hi there both, thank you for you suggestions, where would I put either of those codes please?

This is the coding that I have in the spreadsheet: (Sorry was unsure of how to put in the box like you have)

Sub SaveWorkflow()

Sheets("TabB").Visible = True
Sheets("TabC").Visible = True
Sheets("TabB").Select
Cells.Select
Selection.Copy
Sheets("TabC").Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False


Sheets("TabC").Copy


Dim sDest As String
Dim sFolder As String

sDest = ActiveWorkbook.Worksheets("TabC").Cells(1, 79)

sFolder = Left(sDest, InStrRev(sDest, "\"))

CreateFolder (sFolder)
ActiveWorkbook.SaveAs sDest

ActiveWorkbook.Close

MsgBox ("You Can Now Reset")

End Sub


'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// Purpose : Will Recursively Build ADirectory Tree
'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub CreateFolder(Folder)
On Error Resume Next
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
If Folder <> "" Then
If Not objFSO.FileExists(objFSO.GetParentFolderName(Folder)) Then
Call CreateFolder(objFSO.GetParentFolderName(Folder))
End If
objFSO.CreateFolder (Folder)
End If

End Sub


Any help really is greatly appreciated.

Thanks
Mark
 
Where you setup sDest.
 
Hi there

sDest is the path (E.g. \\Dfs60325.gpn.gov.uk\1234567$\My Documents..) that is currently compiled in Cell CA1

Thanks
Mark
 
I thought you wanted to overwrite that with the actual My Documents folder.
 
Hi there

The path E.g \\Dfs60325.gpn.gov.uk\1234567$\My Documents\SP Sheets\2012-10\AEG1245 Mark.xls

Changes with every use of the spreadsheet:

\\Dfs60325.gpn.gov.uk = this is a constant
1234567$ = changes with every user
My Documents = this is a constant
SP Sheets = this is a constant
2012-10 = this changes depending on information, will either be a date folder, Pending or Residual Action
AEG1245 Mark = changes depending on information entered I.e. filename

Hope this helps.
 
Try this:

Code:
Sub SaveWorkflow()
Dim sDest As String
Dim sFolder As String
Dim sUser As String
    sUser = Right(Environ("USERPROFILE"), Len(Environ("USERPROFILE")) - InStrRev(Environ("USERPROFILE"), "\"))
    Sheets("TabB").Visible = True
    Sheets("TabC").Visible = True
    Sheets("TabB").Cells.Copy
    Sheets("TabC").Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
 
    Sheets("TabC").Copy
    sDest = Application.WorksheetFunction.Substitute( _
        Worksheets("Sheet1").Range("CA1").Value, _
        "1234567$", sUser)
    sFolder = Left(sDest, InStrRev(sDest, "\"))
    CreateFolder (sFolder)
    ActiveWorkbook.SaveAs sDest
 
    ActiveWorkbook.Close
 
    MsgBox ("You Can Now Reset")
 
End Sub
 
I am still having some problems, I am so sorry for being a pain.

Would it be possible for me to send you the spreadsheet?

Thanks
Mark
 
Hi Mark,

I've changed the name of the tabs and keyed in on a certain section for replacing the username. Modify the sDest= code above with the following:
Code:
    sDest = Application.WorksheetFunction.Substitute( _
        Worksheets("SP Sheet").Range("CA1").Value, _
        Worksheets("SP Sheet").Range("CA17").Value, sUser)

Let me know if that fixes it.
 
I am still having some problems, I am so sorry for being a pain.

Would it be possible for me to send you the spreadsheet?

Thanks
Mark

You can attach it here, go to the Advanced button.
 
Back
Top