Hi Booker,
There are several issues you need to address.
- Extract the correct subdirectory name or #deal from the file name
- Identify if the correct directory / file relationship (assuming your 01 - 567567, 02 - 567567 format always holds true)
- Confirm if the sub directory exists (if it doesn't then what happens?)
- If the directory exists AND the file is correctly identified, then move the file as required
Point 1
The following code accepts a file name as a string and returns the subdirectory name (based on your original post)
VBA Code:
Public Function Return_SubDirectory_Name(FileName As String) As String
Dim Splitter() As String
If Len(FileName) > 0 Then
Splitter = Split(FileName, " - ")
If UBound(Splitter) = 1 Then
Splitter = Split(Splitter(1), ".")
Return_SubDirectory_Name = CStr(Splitter(0))
Exit Function
End If
Return_SubDirectory_Name = vbNullString
End If
End Function
Points 2 / 4
The following code accepts a search path (something like "C:\Desktop\MyFiles").
It also uses a nominated archive path where you want the files saved AND the type of files (.msg or whatever) you're looking for.
It then makes a copy of the required file, saves it to the target archive file and finally deletes the original file
VBA Code:
Public Sub Check_Files(Search_Path As String)
Dim File_Name As String
Dim File_Type As String
Dim strFileName As String
Dim Deal_Name As String
Dim Archive_Path As String
Dim Target_Path As String
Dim File_Count As Integer
Archive_Path = ThisWorkbook.Path
Confirm_Directory Search_Path
ChDir Search_Path
File_Type = Search_Path & "*.msg"
strFileName = Dir(File_Type)
Do While Len(strFileName) > 0
Deal_Name = Return_SubDirectory_Name(strFileName)
If Len(Deal_Name) > 0 Then
Target_Path = Archive_Path & "\" & Deal_Name
Confirm_Directory Target_Path
FileCopy Search_Path & "\" & strFileName, Target_Path & "\" & strFileName
Kill Search_Path & "\" & strFileName
File_Count = File_Count + 1
End If
strFileName = Dir
Loop
Debug.Print "Moved " & File_Count & " file(s)"
End Sub
Point 3
The following code will confirm if a directory exists and if it doesn't, it will create the required sub directory
VBA Code:
Public Sub Confirm_Directory(This_Path As String)
Dim Splitter() As String
Dim Test_Path As String
If Dir(This_Path, vbDirectory) <> vbNullString Then
Splitter = Split(This_Path, "\")
For I = LBound(Splitter) To UBound(Splitter)
If I = 0 Then
Test_Path = Splitter(0)
Else
Test_Path = Test_Path & "\" & Splitter(I)
End If
ReTest:
If Dir(Test_Path, vbDirectory) = vbNullString Then
MkDir Test_Path
GoTo ReTest
Else
End If
Next I
End If
End Sub
I would
HIGHLY RECOMMEND that you test this code out with some dummy data first to fully understand how it works before using it on real data.
Some people may not like the deletion aspect of the above codebase, I have used this myself for years, but if you understand when and how it operates you should not have any issues.
While this code does work, you should probably add further checking and error handling measures to ensure it executes the way you expect it to.
I don't know the full extent of the possible variations of directory paths, filenames etc and so this code doesn't account for unforeseen issues.
At the very least, I hope it gets you started along the path to automate this process (sorry but automatize isn't a real word
regards,
BenR