vba6

Sorting filenames by conditions


I want to create a bit of code that saves a file out to a folder (PDF / DWG ) and moves all my files with a lower revision #5 than the current file being saved into a superseded folder.

I cannot see how to set a condition for the revision number: I can't use a wildcard as that would cause issues as other files in the folder would be picked up and moved incorrectly.

I have the save function sorted, I just dont know were to start with filing part.

Examples of the filenames:

Pdf/TE1801_200-01_{name}_#5.PDF
Dwg/TE1801_200-01_{name}_#5.DWG


Solution

  • ' ------------------------------------------------------------------------------
    ' MOVE OLD REVISION TO SUPERSEDED FOLDERS - PDF
    ' ------------------------------------------------------------------------------
    
      
      
    URLPASS = Filepath & "PDF\"
          
    
          
    Dim MyObj As Object, MySource As Object, file As Variant
          
    Set MyObject = CreateObject("Scripting.FileSystemObject")
    Set MySource = MyObject.GetFolder(URLPASS)
            For Each file_ In MySource.Files
    
    
    
    LArray = Split(file_, "#")
    
    
    checkfile = LArray(0)
    
    
    REV = Split(LArray(1), ".")
    
    
    If LArray(0) = checkfile And REV(0) < VERSION Then
    
    
    
    ' FILE FORMATING
    ' ----------------------------------------
    
    
    RECON = Split(file_, "PDF\")
    
        file_ = RECON(1)
    
    RECON = Split(file_, ".")
    
        DRAWNOCONFIG = RECON(0)
        
      
    ' MOVE TO NEW LOCATION
    ' ----------------------------------------
      
      
    If Dir(Filepath & "PDF" & "\SUPERSEDED", vbDirectory) = "" Then '
    MkDir Filepath & "PDF" & "\SUPERSEDED"
    End If
      
      
    Name Filepath & "PDF\" & DRAWNOCONFIG & ".pdf" As Filepath & "PDF\" & "SUPERSEDED\" & DRAWNOCONFIG & ".pdf"
    
    
    
    
    Else
    'DO NOTHING
    GoTo Endline
    End If
    
    
    Endline:
    
    
       Next file_
    
    
    ' ------------------------------------------------------------------------------
    ' MOVE OLD REVISION TO SUPERSEDED FOLDERS - DWG
    ' ------------------------------------------------------------------------------
    
    
    URLPASS = Filepath & "DWG\"
          
    
          
    
          
    Set MyObject = CreateObject("Scripting.FileSystemObject")
    Set MySource = MyObject.GetFolder(URLPASS)
            For Each file_ In MySource.Files
    
    
    
    LArray = Split(file_, "#")
    
    
    checkfile = LArray(0)
    
    
    REV = Split(LArray(1), ".")
    
    
    If LArray(0) = checkfile And REV(0) < VERSION Then
    
    
    
    ' FILE FORMATING
    ' ----------------------------------------
    
    
    RECON = Split(file_, "DWG\")
    
        file_ = RECON(1)
    
    RECON = Split(file_, ".")
    
        DRAWNOCONFIG = RECON(0)
        
      
    ' MOVE TO NEW LOCATION
    ' ----------------------------------------
      
      
    If Dir(Filepath & "DWG" & "\SUPERSEDED", vbDirectory) = "" Then '
    MkDir Filepath & "DWG" & "\SUPERSEDED"
    End If
      
      
    Name Filepath & "DWG\" & DRAWNOCONFIG & ".dwg" As Filepath & "DWG\" & "SUPERSEDED\" & DRAWNOCONFIG & ".dwg"
    
    
    
    
    Else
    'DO NOTHING
    GoTo Endline2
    End If
    
    
    Endline2:
    
    
       Next file_