Kleo Kleo
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.
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
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.
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")
~bp
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
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?
Which folder do you want to create the folder with Name and PID?
ASKER
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
But what?
ASKER
If it already exists a folder with NamePID, does not create a subfolder and a file in the existing one already folder NamePID
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
OK
There's not one on my system and CreateObject("WScript.Shel
Do you actually have the name of s special folder in cell A5?
If you do try using CreateObject("WScript.Shel