Solved Adding Number To File/Folder Name w/ MoveFile (1 Viewer)

EzGoingKev

Registered User.
Local time
Today, 09:36
Joined
Nov 8, 2019
Messages
149
Good morning.

I am using this code to move a ZIP folder from desktop to an archive folder:

Code:
Dim filPath
Dim folPath As String
filPath = Dir(C:\Users\EzGoingKev\ & "*.zip")
folPath = "C:\Users\EzGoingKev\ArchiveFolder\"

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

FSO.MoveFile filPath, folPath

The ZIP folder is a data export from a web based app. If I am making a lot of changes to the data I will sometimes export multiple ZIP files to QC the data as I go along. All the ZIP folder exports have the same name.

I know I can add an IF statement to check to see if the ZIP folder already exists and have it add "(1)" to the name so it will be different. I do not know how to set it to add "(2,3...)" if I download more than one copy.

Is there something that can either be added to the code or a different method to move the folder so it does what I would like to do?
 

June7

AWF VIP
Local time
Today, 05:36
Joined
Mar 9, 2014
Messages
3,731
I gather that these exports do not all occur sequentially in one session. Save the sequence number to a table so when next export is run, lookup the last used number, increment, use that and save new value to table. This can be a table with one field and one record that is updated.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 06:36
Joined
Oct 29, 2018
Messages
17,199
Hi. I suppose you could create a loop to increment a counter to check the file names.
 

EzGoingKev

Registered User.
Local time
Today, 09:36
Joined
Nov 8, 2019
Messages
149
Hi. I suppose you could create a loop to increment a counter to check the file names.
I was kind of hoping someone was going to say to use this function instead because it automatically does what you need.

Thinking about it now, I am thinking about an IF statement to see if the ZIP folder is already in there. If it is in there count the occurrences of the base folder name and add that number to the name. Do you think that could be accomplished with a DCount statement?
 

June7

AWF VIP
Local time
Today, 05:36
Joined
Mar 9, 2014
Messages
3,731
Count what - files in a folder? No, DCount cannot count files in folder.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 06:36
Joined
Oct 29, 2018
Messages
17,199
I was kind of hoping someone was going to say to use this function instead because it automatically does what you need.

Thinking about it now, I am thinking about an IF statement to see if the ZIP folder is already in there. If it is in there count the occurrences of the base folder name and add that number to the name. Do you think that could be accomplished with a DCount statement?
Hi. DCount() works against a table or query, not with folders and files.
 

EzGoingKev

Registered User.
Local time
Today, 09:36
Joined
Nov 8, 2019
Messages
149
If I am heading in the right direction, what function would I use to count folders and files? CountIf?
 

theDBguy

I’m here to help
Staff member
Local time
Today, 06:36
Joined
Oct 29, 2018
Messages
17,199
If I am heading in the right direction, what function would I use to count folders and files? CountIf?
Hi. Most approaches would likely involve using some sort of a loop. For example.

 

conception_native_0123

Well-known member
Local time
Today, 08:36
Joined
Mar 13, 2021
Messages
1,334
If you're looking for code to be able to loop directories of any kind, check out this thread...


And then you can use the count property of the subfolder object turn to return what you need
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 22:36
Joined
May 7, 2009
Messages
14,664
you can copy this to a module.
to use:

call fncMoveFiles(C:\Users\EzGoingKev\*.zip", "C:\Users\EzGoingKev\ArchiveFolder\")

Code:
' movefiles but does not delete source folder
' arnelgp
Public Function fncMoveFiles(ByVal srcFileSpec As String, ByVal trgFolder As String)
Dim colFiles As New Collection
Dim sFile As String, sFolder As String
Dim i As Long
If InStr(1, srcFileSpec, "\") < 1 Then
    srcFileSpec = CurrentProject.Path & "\" & srcFileSpec
End If
' check if target folder exists
' create if it does not
trgFolder = fncForceMKDir(trgFolder)
If Right$(trgFolder, 1) <> "\" Then trgFolder = trgFolder & "\"
sFolder = Left$(srcFileSpec, InStrRev(srcFileSpec, "\"))
sFile = Dir$(srcFileSpec)
Do Until sFile = vbNullString
    colFiles.Add sFile
    sFile = Dir$
Loop
'copy the files
For i = 1 To colFiles.Count
    Call subMoveFile(colFiles(i), sFolder, trgFolder)
Next
'delete source files
For i = 1 To colFiles.Count
    VBA.Kill sFolder & colFiles(i)
Next
Set colFiles = Nothing
End Function

Public Function fncForceMKDir(ByVal sPath As String)
Dim var As Variant
Dim v As Variant
Dim thisPath As String
If Right$(sPath, 1) = "\" Then
    sPath = Left$(sPath, Len(sPath) - 1)
End If
var = Split(sPath, "\")
On Error Resume Next
For Each v In var
    thisPath = thisPath & v
    VBA.MkDir thisPath
    thisPath = thisPath & "\"
Next
fncForceMKDir = Replace$(thisPath & "\", "\\", "\")
End Function

Public Function serialFile(ByVal sFile As String, sPath As String)
Dim ext As String, tmp As String
Dim sNew As String
Dim i As Integer
ext = Mid$(sFile, InStrRev(sFile, "."))
sFile = Replace$(sFile, ext, "")
sPath = Replace$(sPath & "\", "\\", "\")
sNew = sFile
tmp = Dir$(sPath & sFile & ext)
Do Until tmp = vbNullString
    i = i + 1
    sNew = sFile & "(" & i & ")"
    tmp = Dir$(sPath & sNew & ext)
Loop
serialFile = sNew & ext
End Function

Private Sub subMoveFile(ByVal srcFile As String, ByVal srcFolder As String, ByVal trgFolder As String)
Dim sNew As String
srcFolder = Replace$(srcFolder & "\", "\\", "\")
trgFolder = Replace$(trgFolder & "\", "\\", "\")
sNew = serialFile(srcFile, trgFolder)
VBA.FileCopy srcFolder & srcFile, trgFolder & sNew
End Sub
 

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 14:36
Joined
Sep 12, 2006
Messages
14,695
It's fiddly rather than hard. A file name is a string, so you need to separate the part of the string that represents the sequential file count, and then increment that count until you get a new number.

If you do this, you should set the number part to a fixed length string - at least six numbers I would say, so that your numbers run in order. Otherwise you start getting file version 9 and 10, and find that version 10 sorts before version 9. With a long file number, you get 000009 and 000010, and you never get a problem.
 

EzGoingKev

Registered User.
Local time
Today, 09:36
Joined
Nov 8, 2019
Messages
149
@gemma-the-husky - six places? I hear what you are saying but no one at my company is working that hard that we would need six places.

Right now I am using @arnelgp's code and it is working great. Thanks again.
 

jack555

Member
Local time
Today, 18:36
Joined
Apr 20, 2020
Messages
87
you can copy this to a module.
to use:

call fncMoveFiles(C:\Users\EzGoingKev\*.zip", "C:\Users\EzGoingKev\ArchiveFolder\")

Code:
' movefiles but does not delete source folder
' arnelgp
Public Function fncMoveFiles(ByVal srcFileSpec As String, ByVal trgFolder As String)
Dim colFiles As New Collection
Dim sFile As String, sFolder As String
Dim i As Long
If InStr(1, srcFileSpec, "\") < 1 Then
    srcFileSpec = CurrentProject.Path & "\" & srcFileSpec
End If
' check if target folder exists
' create if it does not
trgFolder = fncForceMKDir(trgFolder)
If Right$(trgFolder, 1) <> "\" Then trgFolder = trgFolder & "\"
sFolder = Left$(srcFileSpec, InStrRev(srcFileSpec, "\"))
sFile = Dir$(srcFileSpec)
Do Until sFile = vbNullString
    colFiles.Add sFile
    sFile = Dir$
Loop
'copy the files
For i = 1 To colFiles.Count
    Call subMoveFile(colFiles(i), sFolder, trgFolder)
Next
'delete source files
For i = 1 To colFiles.Count
    VBA.Kill sFolder & colFiles(i)
Next
Set colFiles = Nothing
End Function

Public Function fncForceMKDir(ByVal sPath As String)
Dim var As Variant
Dim v As Variant
Dim thisPath As String
If Right$(sPath, 1) = "\" Then
    sPath = Left$(sPath, Len(sPath) - 1)
End If
var = Split(sPath, "\")
On Error Resume Next
For Each v In var
    thisPath = thisPath & v
    VBA.MkDir thisPath
    thisPath = thisPath & "\"
Next
fncForceMKDir = Replace$(thisPath & "\", "\\", "\")
End Function

Public Function serialFile(ByVal sFile As String, sPath As String)
Dim ext As String, tmp As String
Dim sNew As String
Dim i As Integer
ext = Mid$(sFile, InStrRev(sFile, "."))
sFile = Replace$(sFile, ext, "")
sPath = Replace$(sPath & "\", "\\", "\")
sNew = sFile
tmp = Dir$(sPath & sFile & ext)
Do Until tmp = vbNullString
    i = i + 1
    sNew = sFile & "(" & i & ")"
    tmp = Dir$(sPath & sNew & ext)
Loop
serialFile = sNew & ext
End Function

Private Sub subMoveFile(ByVal srcFile As String, ByVal srcFolder As String, ByVal trgFolder As String)
Dim sNew As String
srcFolder = Replace$(srcFolder & "\", "\\", "\")
trgFolder = Replace$(trgFolder & "\", "\\", "\")
sNew = serialFile(srcFile, trgFolder)
VBA.FileCopy srcFolder & srcFile, trgFolder & sNew
End Sub
@arnelgp, you are awesome. Earlier you provided me with the code for a similar scenario. Appreciated your support to the community members. always clear detailed code for any issue.
 

Users who are viewing this thread

Top Bottom