我有一个包含1000个文件的目录。文件名字符串类似于:ManagerName_EmployeeName_First Assessment.xlsx
但是我需要执行一种特定类型的分组,以便使文件夹依次进入ManagerName
> Employee Name
,然后再进入employee文件夹中的5种评估类型。
我将如何编辑它以标识文件名(ManagerName)中的第一个_
,然后通过该ManagerName
创建一个文件夹,然后通过EmployeeName
创建一个子文件夹,然后容纳所有雇员子文件夹中该雇员下的五个文件?
我知道您需要使用Left(fileName, InStrRev(fileName, "_") > 1)
类型的函数来识别第一个_
左侧的第一个文本字符串,但是我将如何根据员工创建第二个子文件夹在那个经理下?
这是我在想的代码的外壳:
Option Explicit
Sub MoveFiles()
Dim objFSO As Object
Dim objMyFolder As Object
Dim objMyFile As Object
Dim strSourceFolder As String
Dim strDestFolder As String
Application.ScreenUpdating = False
strSourceFolder = "C:\Users\CIB\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objMyFolder = objFSO.GetFolder(strSourceFolder)
For Each objMyFile In objMyFolder.Files
Do While objMyFile <> ""
strDestFolder = Left(objMyFile.Name, InStrRev(objMyFile, "_") - 1)
If Len(Dir(strDestFolder, vbDirectory)) = 0 Then
MkDir strDestFolder
End If
FileCopy strSourceFolder & "\" & objMyFile.Name, strDestFolder & "\" & objMyFile.Name
Kill strSourceFolder & "\" & objMyFile.Name
Loop
Next objMyFile
Set objFSO = Nothing
Set objMyFolder = Nothing
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:0)
我已根据TimWiliams条建议对您的代码进行了相应的更改:
Option Explicit
Sub MoveFiles()
Dim objFSO As Object
Dim objMyFolder As Object
Dim objMyFile As Object
Dim strSourceFolder As String
Dim strDestFolder As String
Dim parts() As String
Dim i As Integer
Application.ScreenUpdating = False
strSourceFolder = "C:\Users\CIB\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objMyFolder = objFSO.GetFolder(strSourceFolder)
For Each objMyFile In objMyFolder.Files
If objMyFile Is Nothing Then GoTo SkipNext
parts = Split(objMyFile.Name, "_")
strDestFolder = strSourceFolder
For i = LBound(parts) To UBound(parts) - 1
strDestFolder = strDestFolder & parts(i) & "\"
'if path does not exists, create it
If Not objFSO.FolderExists(strDestFolder) Then objFSO.CreateFolder strDestFolder
FileCopy strSourceFolder & "\" & objMyFile.Name, strDestFolder & "\" & objMyFile.Name
Kill strSourceFolder & "\" & objMyFile.Name
strDestFolder = ""
SkipNext:
Next objMyFile
Set objFSO = Nothing
Set objMyFolder = Nothing
Application.ScreenUpdating = True
End Sub