Move Files Based On date in Name

[erock24]

I'm looking for a macro that will move files from one folder to another based on the date in the name. For example, in my "SourceFolder" I will have files called "xxx-091009" and "xxx-091509". I need the 091009 version moved to my "DestinFolder". I would need this done for lots of files in the "SourceFolder". The file names will always be text, dash, 6 digit date. I used xxx to represent text.

I have code that lets me pick source and destin folders. Don't know how to move the files based on that condition.

Code to select folders (uses function below)

SourcePath = GetFolderPath("Select Folder With New Coop Files", "Q:\")
 If SourcePath = "" Then Exit Sub
DestinPath = GetFolderPath("Select Folder With Existing Coop Files", "Q:\")
 If DestinPath = "" Then Exit Sub

Function GetFolderPath(Optional ByVal Title As String = "Select a folder", _
                       Optional ByVal InitialPath As String = "Q:\") As String
    PS = Application.PathSeparator
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Choose": .Title = Title: .InitialFileName = InitialPath
        If .Show = -1 Then
            GetFolderPath = .SelectedItems(1)
            If Right$(GetFolderPath, 1) <> PS Then GetFolderPath = GetFolderPath & PS
        End If
    End With
End Function

[Charlize]

You could try something like this (go through your code with F8 to see if it does what it must do and use your mousecursor to see the results of myfile, sourcepath, ... etc) :

Option Explicit
Sub move_files()
Dim SourcePath As String, DestinPath As String
Dim myfile As String
SourcePath = GetFolderPath("Select Folder With New Coop Files", "Q:\")
    If SourcePath = "" Then Exit Sub
DestinPath = GetFolderPath("Select Folder With Existing Coop Files", "Q:\")
    If DestinPath = "" Then Exit Sub
'get the first file in the sourcepath = all files
myfile = Dir(SourcePath & Application.PathSeparator & "*.*")
'if not empty do something
Do While myfile <> vbNullString
'if the second item in array from myfile with delimiter - is 091009 then move
    If Left(Split(myfile, "-")(1), 6) = "091009" Then
        Name SourcePath & Application.PathSeparator & myfile As _
             DestinPath & Application.PathSeparator & myfile
    End If
'get next file
    myfile = Dir
Loop
End Sub

Function GetFolderPath(Optional ByVal Title As String = "Select a folder", _
                       Optional ByVal InitialPath As String = "Q:\") As String
Dim PS As String
    PS = Application.PathSeparator
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Choose": .Title = Title: .InitialFileName = InitialPath
        If .Show = -1 Then
            GetFolderPath = .SelectedItems(1)
            If Right$(GetFolderPath, 1) <> PS Then GetFolderPath = GetFolderPath & PS
        End If
    End With
End Function

Charlize