按条件排序文件名

时间:2018-03-15 15:25:39

标签: vba6

我想创建一些代码,将文件保存到文件夹(PDF / DWG),并将所有文件移动到比保存到已取代文件夹中的当前文件低5的版本。

我无法看到如何设置修订号的条件:我无法使用通配符,因为这会导致问题,因为文件夹中的其他文件将被拾取并错误地移动。

我对保存功能进行了排序,我只是不知道是从归档部分开始的。

文件名示例:

PDF / TE1801_200-01_ {名称} _#5.PDF
DWG / TE1801_200-01_ {名称} _#5.DWG

2 个答案:

答案 0 :(得分:0)

您可以使用GetBaseName Method获取不带扩展名的文件名

然后使用INSTRREV Function查找最后一个“#”的位置(以防有人在{name}部分使用“#”)。

接下来使用LEFT Function获取“TE1801_200-01_ {name} _#”部分,现在您可以像“TE1801_200-01_ {name} _#*。*”一样添加通配符。 (在这个阶段你最后是否有“#”并不重要。)

预先填写完整路径并获取所有匹配的文件。

移动这些文件。

现在使用其修订号保存当前文件。

答案 1 :(得分:0)

' ------------------------------------------------------------------------------
' 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_