根据名称将excel文件保存到子文件夹中

我有一个macros读取一些CSV文件,并从这些创buildExcel文件。 然后将创build的文件保存在CSV文件所在的文件夹中。 我需要创build一个子文件夹,根据部分名称对excel文件进​​行分组,并将Excel文件保存在这些子文件夹中:例如:

IM_26451405_abc_FUM_20.09.2016.xls IM_26451405_gdd_FUM_20.09.2016.xls 

应保存在名称为: 26451405

 IM_26451234_abc_FUM_20.09.2016.xls IM_26451234_gdd_FUM_20.09.2016.xls IM_26451234_wer_FUM_20.09.2016.xls 

应保存在名称为26451234等的子文件夹中…

这个部分是Sub。

 Public Sub StartProcessing() Dim formatName As String Dim currentSheet As Worksheet Dim lastSheet As Worksheet Dim destFileName As String Dim flagGotDestName As Boolean Dim destWorkbook As Workbook Set csvProcessor = Me For Each file In csvProcessor.getFiles flagGotDestName = False Set destWorkbook = Nothing Set currentSheet = Nothing For Each cell In file fileName = cell.Text sheetName = cell.Offset(0, 1).Text formatName = cell.Offset(0, 2).Text Set currentSheet = getWorksheetFromCSV(sheetName, fileName) If Not flagGotDestName Then destFileName = Left(fileName, InStrRev(fileName, "_", , vbTextCompare)) & "FUM_" & format(Now(), "dd.mm.yyyy") & ".xls" destFileName = Left(destFileName, InStrRev(destFileName, "\", , vbTextCompare)) & "FM_" & Right(destFileName, Len(destFileName) - InStrRev(destFileName, "\", , vbTextCompare)) flagGotDestName = True currentSheet.Move Set destWorkbook = ActiveWorkbook End If With destWorkbook Set currentSheet = .Sheets(Sheets.Count) End With formatSheet currentSheet, formatName Set lastSheet = currentSheet Next ActiveWorkbook.Sheets(1).Activate On Error Resume Next Application.DisplayAlerts = False destWorkbook.SaveAs fileName:=destFileName, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False, ConflictResolution:=xlLocalSessionChanges destWorkbook.Close Err.Clear On Error GoTo 0 Next End Sub 

示例解决scheme

 [...] mainPath = "C:\Users\RandomGuy\Workspace\" fileName = "IM_26451405_abc_FUM_20.09.2016.xls" subDrectoryName = Mid(fileName, 4, 8) filePath = mainPath & subDirectoryName & "\" If Dir(filePath) <> "" Then MkDir filePath End If destWorkbook.SaveAs fileName:=filePath, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False, ConflictResolution:=xlLocalSessionChanges 

所以,你需要的是find这个mainPath ,它是你的CSV文件的存储目录。 我不知道这是否总是相同的目录,或者它是基于单元格值的dynamic。 然后提取文件夹名称表单文件名并检查该文件夹是否已经存在。 如果没有,创build一个并保存文件。