Hi - can anyone help me out please? I've learnt VBA from reading boards and searching google so the following is probably not best practice!
I have the following code which works fine when looping through the first set of subfolders for myLocationDest but as soon as it goes to search the subfolders of myLocationSub1 (the returned subfolder of myLocationDest) it doesn't return the correct folders that match the reference
The reason for this code is to automatically file files in the temp directory into SubFolders which match the references contained within the SubFolders. An example of this is...
Ref 1234.0102 report.xls would be filed as...
C:\Projects\1234 My Project\01 Reports\02 Excel Reports\
I have 3 GetFolder searches to try and acheive this...
1 to find the \1234 My Project\ subfolder (from 1234.0102)
1 to find the \01 Reports subfolder (from 1234.0102)
1 to find the \02 Excel Reports\ subfolder (from 1234.0102)
[vba]
On Error Resume Next
Dim myName As String
Dim myLocationTemp As String
Dim myLocationDest As String
Dim myLocationSub1 As String
Dim myLocationSub2 As String
Dim FSO As Object
Dim FolderSubFolder As Object
Dim FolderSubFolderSub1 As Folder
Dim FolderSubFolderSub2 As Folder
Dim TempString As String
Dim TempString2 As String
Dim lCount As Long
Dim myFullFilename As String
Dim myFilename As String
Dim myRef As String
Dim myRefSub1 As String
Dim myRefSub2 As String
Dim myRefSubCheck As String
myLocationTemp = "C:\Projects\Temp\"
myLocationDest = "C:\Projects\"
Set FSO = CreateObject("Scripting.FileSystemObject")
With Application.FileSearch
.NewSearch
.LookIn = myLocationTemp
.FileType = msoFileTypeAllFiles
If .Execute > 0 Then
For lCount = 1 To .FoundFiles.Count
myFullFilename = .FoundFiles(lCount)
myFilename = Mid(.FoundFiles(lCount), InStr(.FoundFiles(lCount), "Temp\") + 5, 256)
myRef = Mid(.FoundFiles(lCount), InStr(.FoundFiles(lCount), "Ref ") + 4, 4)
myRefSubCheck = Mid(.FoundFiles(lCount), InStr(.FoundFiles(lCount), "Ref ") + 9, 4) ' eg 1234-0102
myRefSub1 = Mid(.FoundFiles(lCount), InStr(.FoundFiles(lCount), "Ref ") + 9, 2) ' eg 01
myRefSub2 = Mid(.FoundFiles(lCount), InStr(.FoundFiles(lCount), "Ref ") + 11, 2) ' eg 02
For Each FolderSubFolder In FSO.GetFolder(myLocationDest).SubFolders
TempString = FolderSubFolder.Name
myLocationSub1 = TempString
If myFullFilename = "" Then GoTo NextFile Else
If Left(TempString, InStr(TempString, myRef)) = True Then GoTo Sub1 Else
Next FolderSubFolder
Sub1:
For Each FolderSubFolderSub1 In FSO.GetFolder(myLocationDest & myLocationSub1 & "\").SubFolders
TempStringSub1 = FolderSubFolderSub1.Name
myLocationSub2 = TempStringSub1
If Left(TempStringSub1, InStr(TempStringSub1, myRefSub1)) = True Then GoTo Sub2 Else
Next FolderSubFolderSub1
Sub2:
For Each FolderSubFolderSub2 In FSO.GetFolder(myLocationDest & myLocationSub1 _
& "\" & myLocationSub2 & "\").SubFolders
TempStringSub2 = FolderSubFolderSub2.Name
If Left(TempStringSub2, InStr(TempStringSub2, myRefSub2)) = True Then GoTo MoveFile Else
Next FolderSubFolderSub2
MoveFile:
If myRefSubCheck >= 101 Then Name myFullFilename As myLocationDest _
& TempString & "\" & TempStringSub1 & "\" & TempStringSub2 & "\" & myFilename Else
If myRefSubCheck >= 1 Then Name myFullFilename As myLocationDest _
& TempString & "\" & TempStringSub1 & "\" & myFilename Else
If myRefSubCheck < 1 Then Name myFullFilename As myLocationDest _
& TempString & "\" & myFilename
NextFile:
Next lCount
End If
End With
[/vba]
Edit Lucas: Line breaks added so the code doesn't run off the page for those with small monitors
Any help would be greatly appreciated
Cheers,
rrenis