asked on

VBA code for SubFolders

I need a help. I want to create a subfolder in

SpecialFolders ("A5"). The subfolder name must be ActiveSheet.Range ("B5"). Inside the subfolder the file SaveName = LDate & "_" & Hour(Now) & Minute(Now) & "_" & "Work" & "_" & ActiveSheet.Range("B5") & ".xlsm".
Here's where I've come. The subfolder is missing.

Public Sub SaveToDir()

CDir = CreateObject("WScript.Shell").SpecialFolders("A5")

SaveDir = ActiveSheet.Range("A5")

If Len(Dir(SaveDir, vbDirectory)) = 0 Then
   MkDir SaveDir
End If

LDate = Date


SaveName = LDate & "_" & Hour(Now) & Minute(Now) & "_" & "Work" & "_" & ActiveSheet.Range("B5") & ".xlsm"

If Len(Dir(SaveDir & "\" & SaveName, vbDirectory)) > 0 Then
    Resp = MsgBox("File name:   " & SaveName & vbCrLf & vbCrLf & "already exists in:  " & vbCrLf & vbCrLf & SaveDir & vbCrLf & vbCrLf & "Press Okay to continue, Cancel to abort", vbOKCancel)
End If
'

If Resp = vbCancel Then
    Exit Sub
End If

Application.DisplayAlerts = False



ActiveWorkbook.SaveCopyAs ActiveSheet.Range("A5") & "\" & SaveName

CurrentFile = ActiveSheet.Range("A5") & "\" & SaveName

MsgBox ("File name:   " & SaveName & vbCrLf & vbCrLf & "has been saved to  " & vbCrLf & vbCrLf & SaveDir)

Workbooks.Open CurrentFile
       


        
999   End Sub

Open in new window

Norie

Are you sure there is a Windows special folder named A5?

There's not one on my system and CreateObject("WScript.Shell").SpecialFolders("A5") returns an empty string.

Do you actually have the name of s special folder in cell A5?

If you do try using CreateObject("WScript.Shell").SpecialFolders(Range("A5").Value).

Bill Prew

What is in cell A5, a full path, or the symbolic name of a special folder?

If it's a path then the MKDIR should create it.

This statement is not correct, but I can't propose an alternative until I know better what you are doing, and what is in A5.

CDir = CreateObject("WScript.Shell").SpecialFolders("A5")

Open in new window

~bp

Kleo Kleo

ASKER

A5 is a cell in a file. This box contains Name and PID. A folder with Name and PID has to be created. This folder must have a subfolder with the name of that appears in the cell B5 in excel file. In the subfolder creates excel file whit name date / hour / minute/seconds / name of case which should be taken from cell B5 in the excel file

Norie

If that's the case there's no need to use SpecialFolders.

Which folder do you want to create the folder with Name and PID?

Kleo Kleo

ASKER

When pressing the Temp Work button, must be created two folders and an excel file.
Folder 1: "Name_PID" (A5)
subfolder: "case"(B5)
Excel file: "Work_case"(B5)

Norie

So you want to create a folder in the Documents folder using the Name and PID, create a folder in that folder using the value from B5 and then save a copy of the active workbook in that folder?

Dim strDocs As String
Dim strNamePID As String
Dim strSaveDir As String
Dim strFileName As String

    strFileName = Date & "_" & Hour(Now) & Minute(Now) & "_" & "Work" & "_" & ActiveSheet.Range("B5") & ".xlsm"

    strDocs = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")

    strNamePID = Range("A5").Value

    MkDir strDocs & "\" & strNamePID 

    strSaveDir = strDocs & "\" & strNamePID & "\" & Range("B5").Value

    MkDir strSaveDir

   ActiveWorkbook.SaveCopyAs strSaveDir &  "\" & strFileName

Open in new window

Kleo Kleo

ASKER

Thank you very much, but ..... :)