Question

我有一个宏，它读取一些CSV文件并从中创建excel文件。然后将创建的文件保存在存在CSV文件的同一文件夹中。我需要创建子文件夹，根据其名称的一部分对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

Answer 1

示例解决方案：

[...]

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

因此，您需要找到的是存储CSV文件的目录mainPath。我不知道这是否始终是相同的目录，或者它是基于单元格值的动态。然后提取文件夹名称表单文件名并检查此文件夹是否已存在。如果没有，请创建一个并在其中保存文件。

根据名称

1 个答案: