Moving files to a subfolder based on partial filename in VBA without using FSO-CodePudding

This code is run from a macro-enabled workbook. It checks if there is already any files in the same folder as the workbook which names start with "repositorio nóminas" and moves them to a subfolder.

It uses the method "Name _ As _" to move them, but the "* . *" argument does not seem to work in this context. How can I check for partial name while using the "Name _ As _" method?

Dim wb      As Workbook  
Dim path    As String

Set wb = ActiveWorkbook    
path = wb.path & "\"

If path & "\repositorio" & "*.*" = True Then            !!!Error 13 Type Mismatch!!!
    Name path & "\repositorio" & "*.*" As path & "backups\" & "\repositorio" & "*.*"
End If

For clarification, I got the idea of trying the "* . *" argument from this piece of code I had found in the past, where it uses "path" and the argument to find anything that exists in that path.

str = Dir(path & "*.*")

Do While str <> ""
    ctr = ctr   1
    str = Dir
 Loop

CodePudding user response：

As already written, you need to rename your files one by one. So the logic is: Loop over all files that matches the filename pattern and execute the name command.

To loop over all files in a folder, you can use the Dir-command (or use the FileSystemObject). The logic of the Dir-command is the following: You issue an initial Dir with a filename pattern (including the path). You will get the name of the first matching file as result. To get the next matching file, you issue another Dir-command, but without parameters. As long as there are matching files, Dir` will return the name. When there is no file left, it returns an empty string.

Note that the filename that is returned by Dir does not contain the path, only the file name.

So your code would look like that

Const FilenamePattern = "repositorio*.*"
Dim path as String, backupPath as String
path = wb.path & "\"
backupPath = path & "backups\"

Dim filename as string
filename = Dir(path & FilenamePattern)   ' Get first file
Do While filename <> ""
    ' Move the file to backup folder
    Name path & filename As backupPath & filename
    filename = Dir                       ' Get next file, if any
Loop

CodePudding user response：

I ended up making this public sub that I can call and it will check if the file or folder exists and create it if it doesn't. It uses @FunThomas's idea of creating the file from the Dir loop.

Public Sub fmkr(name As String, path As String, _
                    Optional typ As Integer = 0, Optional fldr As String = "")

Dim typ2    As String
Dim str     As String

If typ = 0 Then
    typ2 = vbNormal
    name = name & ".xlsx"
ElseIf typ = 1 Then
    typ2 = vbDirectory
End If

If fldr <> "" Then
    fldr = fldr & "\"
End If

str = Dir(path & fldr & name, typ2)
            
If str = vbNullString Then
    If typ = 0 Then
        Workbooks.Add.SaveAs path & fldr & name
        Workbooks(name).Close
    ElseIf typ = 1 Then
        MkDir path & name
    End If
End If
    
End Sub

I then used this if statement to move the existing files:

str = Dir(path & "*.xlsx")
If str = "" Then
    Call fmkr(name, path)
Else
    Name path & str As path & "backups\repositorios old\" & str
    Call fmkr(name, path)
End If