how to create multilevel subfolder and transfer the files to the last subfolder (1 Viewer)

[eugzl]

Hi All.
I would like to create programmatically new network subfolder where name of the will be include the current date and transfer files to that subfolder from other network subfolder from the same path. If that is possible to do in Access VBA. Can somebody show and explain how to create it?
Thanks.

 

[arnelgp]

to create a folder:
call foceMKdir("the folder path to create here")

Public Function forceMKDir(ByVal sPath As String)
    Dim v As Variant
    Dim s As String
    Dim i As Integer
    v = Split(sPath, "\")
    On Error Resume Next
    For i = 0 To UBound(v)
        s = s & v(i)
        VBA.MkDir s
        s = s & "\"
    Next
End Function

 

[eugzl]

to create a folder:
call foceMKdir("the folder path to create here")

Public Function forceMKDir(ByVal sPath As String)
    Dim v As Variant
    Dim s As String
    Dim i As Integer
    v = Split(sPath, "\")
    On Error Resume Next
    For i = 0 To UBound(v)
        s = s & v(i)
        VBA.MkDir s
        s = s & "\"
    Next
End Function

Hi arnelgp. Thanks for reply.
I tried to use your function like this

Private Sub cmdFolder_Click()
    Dim sPath As String
    sPath = "c:\This PC\Documents\Test&CStr(now()"
    forceMKdir (sPath)
End Sub

I didn't get error, but folder was not created. I located the function in the Form code window. What I did wrong?
Thanks

 

[arnelgp]

there are Symbols that are not allowed in folder/filenames.
i am not sure if "/" or ":" is allowed.
better use Undescore ("_") in place of then

sPath=Environ$("UserProfile") & "\documents\test & Format(Now(), "dd_mm_yyyy_hh_nn_ss")
Call forceMkDir(sPath)

 

[eugzl]

there are Symbols that are not allowed in folder/filenames.
i am not sure if "/" or ":" is allowed.
better use Undescore ("_") in place of then

sPath=Environ$("UserProfile") & "\documents\test & Format(Now(), "dd_mm_yyyy_hh_nn_ss")
Call forceMkDir(sPath)

I changed code like this

Private Sub cmdFolder_Click()
    Dim sPath As String
    sPath = Environ$("UserProfile") & "\documents\test & Format(Now(), "dd_mm_yyyy_hh_nn_ss")
    forceMKDir (sPath)
End Sub

Access says Syntax error in line sPath=.... How to fix? Thanks.

 

[arnelgp]

what version do you have?

Edit:

spath = Environ$("UserProfile") & "\documents\test" & Format(Now(), "dd_mm_yyyy_hh_nn_ss")

 

[SHANEMAC51]

I didn't get error, but folder was not created.

Private Sub cmdFolder_Click()
    Dim sPath As String, d1
    d1 = Format(Now(), "yyyy-mm-dd hh-nn-ss")
    d1 = Replace(d1, ":", "_")
    d1 = Replace(d1, ".", "_")
    d1 = Replace(d1, "\", "_")
    sPath = "c:\This PC3\Documents\Test" & d1
    forceMKDir (sPath)
''    start1
''''    c:\This PC3   ok
''''c:\This PC3\Documents       ok
''''c:\This PC3\Documents\Test2022-03-12 10-20-11           ok
''start2
''''c:\This PC3    err= 75      Path/File access error
''''c:\This PC3\Documents        err= 75      Path/File access error
''''c:\This PC3\Documents\Test2022-03-12 10-20-43           ok
End Sub
Public Function forceMKDir(ByVal sPath As String)
    Dim v As Variant
    Dim s As String
    Dim i As Integer
    v = Split(sPath, "\")
    s = v(0) & "\"
    On Error Resume Next
    For i = 1 To UBound(v)
        s = s & v(i)
        Debug.Print s,
        VBA.MkDir s
        If Err.Number = 0 Then
        Debug.Print "ok"
        Else
if err.number<>75 then
        Debug.Print " err="; Err.Number, Err.Description
endif
        Err.Clear
        '''err= 75      Path/File access error
        End If
        s = s & "\"
    Next
End Function

 

[SHANEMAC51]

Access says Syntax error in line sPath=.... How to fix? Thanks

Private Sub cmdFolder2_Click()
    Dim sPath As String
    sPath = Environ$("UserProfile") & "\documents\test" & Format(Now(), "yyyy_mm_dd_hh_nn_ss")
    forceMKDir (sPath)
End Sub

Public Function forceMKDir(ByVal sPath As String)
    Dim v As Variant
    Dim s As String
    Dim i As Integer

    v = Split(sPath, "\")
    s = v(0) & "\"

    On Error Resume Next
    For i = 1 To UBound(v)
        s = s & v(i)
        Debug.Print s,
        VBA.MkDir s
        If Err.Number = 0 Then
        Debug.Print "ok"
        Else
if err.number<>75 then
        Debug.Print " err="; Err.Number, Err.Description
endif
        Err.Clear
        '''err= 75      Path/File access error
        End If

        s = s & "\"
    Next
End Function

 

[eugzl]

what version do you have?

Edit:

spath = Environ$("UserProfile") & "\documents\test" & Format(Now(), "dd_mm_yyyy_hh_nn_ss")

After your correction syntax error is gone. Thanks a lot. Works great, awesome.

 

[eugzl]

Private Sub cmdFolder2_Click()
    Dim sPath As String
    sPath = Environ$("UserProfile") & "\documents\test" & Format(Now(), "yyyy_mm_dd_hh_nn_ss")
    forceMKDir (sPath)
End Sub

Public Function forceMKDir(ByVal sPath As String)
    Dim v As Variant
    Dim s As String
    Dim i As Integer

    v = Split(sPath, "\")
    s = v(0) & "\"

    On Error Resume Next
    For i = 1 To UBound(v)
        s = s & v(i)
        Debug.Print s,
        VBA.MkDir s
        If Err.Number = 0 Then
        Debug.Print "ok"
        Else
if err.number<>75 then
        Debug.Print " err="; Err.Number, Err.Description
endif
        Err.Clear
        '''err= 75      Path/File access error
        End If

        s = s & "\"
    Next
End Function

Now I created multilevel folder. How to programmatically transfer files from one subfolder to another?
Thanks

 

[Eugene-LS]

Now I created multilevel folder. How to programmatically transfer files from one subfolder to another?

FileCopy "Source Path", "Destination Path"

Moving:

Dim FSO As Object  'File System Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.MoveFile "c:\mydocuments\letters\*.doc", "c:\tempfolder\"