Solved Adding Number To File/Folder Name w/ MoveFile

[EzGoingKev]

Good morning.

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

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]

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]

Hi. I suppose you could create a loop to increment a counter to check the file names.

 

[EzGoingKev]

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]

Count what - files in a folder? No, DCount cannot count files in folder.

 

[theDBguy]

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]

If I am heading in the right direction, what function would I use to count folders and files? CountIf?

 

[theDBguy]

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.

Folders collection

Office VBA reference topic

docs.microsoft.com

 

[theDBguy]

Just FYI, if you use the above approach, just letting you know a Dictionary has a Count property.

Count property (Dictionary object)

Office VBA reference topic

docs.microsoft.com

 

[conception_native_0123]

If you're looking for code to be able to loop directories of any kind, check out this thread...

VBA code to loop directories, subdirectories and files

give that this thread was just created: https://www.excelforum.com/excel-programming-vba-macros/1333296-code-to-copy-data-from-multiple-files-under-multiple-folders.html these blocks of code should be used by people here quite a bit, I would assume. Change the inner workings of them to do...

www.excelforum.com

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

 

[arnelgp]

you can copy this to a module.
to use:

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

' 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

 

[EzGoingKev]

@arnelgp - that code worked awesome. Thanks.

If I had a payroll I would put you on it. LOL.

 

[gemma-the-husky]

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]

@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.

 

[gemma-the-husky]

@EzGoingKev
You are right. 5 would be plenty!

 

[jack555]

you can copy this to a module.
to use:

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

' 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.