Move files in folder based on wildcard match

[cortexnotion]

Hi All

I need to loop through the source folder and move all files that don't contain the string to the target folder.

I have read that using "Dir" is the best way to proceed, but would value your help with the code. What I have so far is below.

Many thanks

Sub movefiles()

Dim SourceDir As String, TargetDir As String, Filename As String, LW1 as long

SourceDir = "S:\Test\"
TargetDir = "S:\Test\Completed\"
LW1 = Application.Evaluate("INT((TODAY()-1)/7)*7+1")
Filename = "*WE-" & LW1("dd-mm-yyyy") & "*.xlsx"

Do While (Dir(SourceDir <> ""))
    'If SourceDir file does not contain FileName string then move SourceDir file to TargetDir
Loop
   
End Sub

 

[EFANYoutube]

Try using the "Like" keywork as it works with wildcards

Sub movefiles()

Dim SourceDir As String, TargetDir As String, Filename As String, LW1 as long

SourceDir = "S:\Test\"
TargetDir = "S:\Test\Completed\"
LW1 = Application.Evaluate("INT((TODAY()-1)/7)*7+1")
Filename ="*WE-" & LW1("dd-mm-yyyy") & "*.xlsx"

Do While (Dir(SourceDir <> ""))
    'If SourceDir file does not contain FileName string then move SourceDir file to TargetDir
    If Dir Like Filename then 
            Move the file
    End If
Loop
  
End Sub

 

[cortexnotion]

Thank you @EFANYoutube

I have made progress where the files are move if the string is found within the filename. How would I turn the statement negative so files that don't match are moved? I tried "If Not" but nothing was moved?

Thanks again

Sub Create()

Dim SourceDir As Variant, NewDir As Variant, FileName As Variant, LW1 As Long, SourceFiles As Variant

SourceDir = "S:\Test\"
NewDir = "S:\Test\Completed\"
LW1 = Application.Evaluate("INT((TODAY()-1)/7)*7+1")
FileName = "*WE-" & Format(LW1, "dd-mm-yyyy") & "*.xlsx"
SourceFiles = Dir(SourceDir & FileName)

With CreateObject("Scripting.FileSystemObject")
    Do While SourceFiles <> ""
    FileName = SourceFiles
        If SourceFiles Like FileName Then
            .MoveFile Source:=SourceDir & FileName, Destination:=NewDir & FileName
        End If
        SourceFiles = Dir
    Loop
End With

End Sub

 

[EFANYoutube]

Sub Create()

Dim SourceDir As Variant, NewDir As Variant, FileName As Variant, LW1 As Long, SourceFiles As Variant

SourceDir = "S:\Test\"
NewDir = "S:\Test\Completed\"
LW1 = Application.Evaluate("INT((TODAY()-1)/7)*7+1")
FileName = "*WE-" & Format(LW1, "dd-mm-yyyy") & "*.xlsx"
SourceFiles = Dir(SourceDir & FileName)

With CreateObject("Scripting.FileSystemObject")
    Do While SourceFiles <> ""
    FileName = SourceFiles
        If SourceFiles Like FileName Then
            .MoveFile Source:=SourceDir & FileName, Destination:=NewDir & FileName
        Else
            'Move everything else
        End If
        SourceFiles = Dir
    Loop
End With

End Sub

 

[cortexnotion]

Hi @EFANYoutube, no joy with the else command im afraid, non matching files are not moving if I use .movefile condition there.

 

[John_w]

How about this:

Sub movefiles()

    Dim SourceDir As String, TargetDir As String, matchFilename As String, LW1 As Long
    Dim Filename As String
   
    SourceDir = "S:\Test\"
    TargetDir = "S:\Test\Completed\"

    If Right(SourceDir, 1) <> "\" Then SourceDir = SourceDir & "\"
    If Right(TargetDir, 1) <> "\" Then TargetDir = TargetDir & "\"
   
    LW1 = Int((Date - 1) / 7) * 7 + 1
    matchFilename = "*WE-" & Format(LW1, "dd-mm-yyyy") & "*.xlsx"
   
    Filename = Dir(SourceDir & "*.*")
    Do While Filename <> vbNullString
        If Not Filename Like matchFilename Then
            Name SourceDir & Filename As TargetDir & Filename
        End If
        Filename = Dir
    Loop
  
End Sub

 

[cortexnotion]

@John_w brilliant, that works great thank you