VBA - Folder relative name question

[kjdr]

I have snipped this code for use as part of an export task in excel.
The problem is to make the reference to the actual folder in a later query, what will the relative path to the last created folder be?

Code:
Sub makebackupfolder()
'create reference for file system object
Set fs = CreateObject("Scripting.FileSystemObject")
folderpath = "c:\Users\kdr\Documents\IDS\P01\"

'Check folder name "Export" in folderpath
If fs.FolderExists(folderpath & "\Export\") = True Then
If fs.FolderExists(folderpath & "\Export\" & Replace(Format(Now(), "dd/MM/yyyy_Hh/Nn"), "/", "_")) = True Then
Exit Sub
Else
fs.createfolder folderpath & "\Export\" & Replace(Format(Now(), "dd/MM/yyyy_Hh/Nn"), "/", "_")
End If

Else
'if log folder missing then create it
fs.createfolder folderpath & "\Export\"
fs.createfolder folderpath & "\Export\" & Replace(Format(Now(), "dd/MM/yyyy_Hh/Nn"), "/", "_")
End If
End Sub

Thanks!
KD

 

[Warship]

If I understand you correctly, try:

Sub makebackupfolder()
    Dim TimeDateStamp As String
    Dim FolderJustCreated As String
    TimeDateStamp = Format(Now, "dd_MM_yyyy_Hh_Nn")
    'create reference for file system object
    Set fs = CreateObject("Scripting.FileSystemObject")
    folderpath = "c:\Users\kdr\Documents\IDS\P01\"
    'Check folder name "Export" in folderpath
    If fs.FolderExists(folderpath & "\Export\") = True Then
        If fs.FolderExists(folderpath & "\Export\" & TimeDateStamp) = True Then
            Exit Sub
        Else
            fs.createfolder folderpath & "\Export\" & TimeDateStamp
        End If
    Else
        'if log folder missing then create it
        fs.createfolder folderpath & "\Export\"
        fs.createfolder folderpath & "\Export\" & TimeDateStamp
    End If
    FolderJustCreated = folderpath & "\Export\" & TimeDateStamp
End Sub

Note that "Replace" is not needed.

 

[Warship]

Better:

Sub makebackupfolder2()
    Dim TimeDateStamp As String
    Dim FolderJustCreated As String
    TimeDateStamp = Format(Now(), "dd_MM_yyyy_Hh_Nn")
    'create reference for file system object
    Set fs = CreateObject("Scripting.FileSystemObject")
    folderpath = "c:\Users\kdr\Documents\IDS\P01\"
    'Check folder name "Export" in folderpath
    If fs.FolderExists(folderpath & "\Export\") = False Then
        'if log folder missing then create it
        fs.createfolder folderpath & "\Export\"
    End If
    If fs.FolderExists(folderpath & "\Export\" & TimeDateStamp) = False Then
        fs.createfolder folderpath & "\Export\" & TimeDateStamp
    End If
    FolderJustCreated = folderpath & "\Export\" & TimeDateStamp
End Sub

 

[kjdr]

Thanks, a nice bit of code. It works good.
But why do I get a runtime error '1004' when I run this:

code:
'Save the file with Tag number
Workbooks("P01_SPEC.XLS").Activate
ThisFile = Range("F4").Value


ActiveWorkbook.SaveAs Filename:=FolderJustCreated & ThisFile

ActiveWorkbook.Close True


I want to save a single file into the folder just created, I think the path should be right.

KD

 

[GTO]

ActiveWorkbook.SaveAs Filename:=FolderJustCreated & "\" & ThisFile

ActiveWorkbook.Close True


I want to save a single file into the folder just created, I think the path should be right.

KD

You may just need a path seperator if I am reading correctly. You can check to make sure you are keeping the trailing seperator something like:

Option Explicit
    
Sub exa()
Dim FSO             As Object
Dim strFolderPath   As String
Dim arySubfolders() As Variant
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    strFolderPath = IncludeTrailingSeperator(ThisWorkbook.Path)  '<---change path to suit
    
    If AddFolders(FSO, strFolderPath, "Export", Format(Now(), "dd_mm_yyyy_Hh_Nn")) Then
        ' SaveAs  or save a copy etc
        ThisWorkbook.SaveCopyAs strFolderPath & "MyTest.xls"
    End If
End Sub
    
Function AddFolders(fs As Object, OrigPath As String, ParamArray FolderNames()) As Boolean
Dim i As Long
    
    On Error GoTo Bail
    For i = LBound(FolderNames) To UBound(FolderNames)
        If Not fs.FolderExists(OrigPath & FolderNames(i)) Then
            fs.CreateFolder OrigPath & FolderNames(i)
            OrigPath = IncludeTrailingSeperator(OrigPath & FolderNames(i))
        Else
            OrigPath = IncludeTrailingSeperator(OrigPath & FolderNames(i))
        End If
    Next
    
    AddFolders = True
Bail:
End Function
    
Function IncludeTrailingSeperator(Path As String) As String
    If Not Right(Path, 1) = Application.PathSeparator Then
        IncludeTrailingSeperator = Path & Application.PathSeparator
    Else
        IncludeTrailingSeperator = Path
    End If
End Function

Hoep that helps,

Mark

 

[kjdr]

Sorry, didn't get the separator to work.
I also did try to implement you're otherr bit of code, but I was not able to get it right due to a loop in the original code. (So much for holding back information...)

I am a newbie to VB, as you might have understood. Thanks for you're patiente.

Here's the full code.
The scope is to export single rowes from the main document ("DATA_P01") into new unique documents using the template "P01_SPEC" and save the entire batch into the new folder labeled with todays date.
Code:

Sub exportallposts()

Dim fs
Dim NewPath
Dim Pos
Dim ThisFile
Application.ScreenUpdating = False

'create reference for file system object
Set fs = CreateObject("Scripting.FileSystemObject")
'set basic folder path to D: we avoid c: because it may be contain system files
folderpath = ThisWorkbook.Path

'Check folder name "Export" in folderpath
If fs.FolderExists(folderpath & "\Export\") = True Then
If fs.FolderExists(folderpath & "\Export\" & (Format(Now(), "dd/MM/yyyy"))) = True Then
Exit Sub

Else

fs.createfolder folderpath & "\Export\" & (Format(Now(), "dd/MM/yyyy"))
End If


Else
'if log folder missing then create it
fs.createfolder folderpath & "\Export\"
fs.createfolder folderpath & "\Export\" & (Format(Now(), "dd/MM/yyyy"))
End If


'Activate database
Workbooks("DATA_P01.xls").Activate
Range("C4").Activate
Pos = ActiveCell.Value

'Loop function
Do While IsEmpty(ActiveCell.Offset(0, 0)) = False

ActiveCell.Offset(0, 4).Select
Pos = ActiveCell.Value

''' Populating the sheets


'Save the file with Tag number
Workbooks("P01_SPEC.XLS").Activate
ThisFile = Range("F4").Value



NewPath = (folderpath & "\Export\")
ActiveWorkbook.SaveAs Filename:=(folderpath & "\" & "\" & ThisFile)

ActiveWorkbook.Close True


Workbooks("DATA_P01.xls").Activate
Pos = ActiveCell.Offset(1, -84).Select

Loop

Application.ScreenUpdating = True


End Sub


</PRE>

I have left out the popoulation bit, possibly also taken away a good laugh for the code-experts but I think it's better this way.

The "problem" is marked in red. It returns a runtime-error 1004 - no matter how I try to state the path.

Regards
KD