根据文件的名称和date，将文件夹中的工作簿合并到中央工作簿中

我有一个文件夹中的多个文件。 我需要根据原始文件的名称和date将这些单独的文件合并到具有多个工作表的中央工作簿中，这些工作簿与原始工作簿的名称相同。

例如，在一个文件夹中我可能有以下文件：

Fund1809_Equity_20140917 Fund1809_FI_20140917 Fund1809_Unlisted_20140917 Fund1809_Equity_20141221 Fund1809_FI_20141221 Fund780_Equity_20140917 Fund68092_Equity_20140917 

我需要将具有相同基金名称和date的所有文件放入工作簿中。 因此，预期的结果应该是4个工作簿：

1. Fund1089_20140917与“股权”，“FI”和“未列出”选项卡

2. Fund1089_20141221带有“Equity”和“FI”选项卡

3. Fund780_20140917与“权益”选项卡

4. Fund68092_20140917与“权益”选项卡

我有基于基金名称的前4个字符sorting的代码。 因此，我遇到了问题，因为基金代码的长度不固定为4，也不按datesorting。 这是我的代码：

 Sub test() Const TO_DELETE_SHEET_NAME As String = "toBeDeleted" '------------------------------------------------------------------ Dim settingSheetsNumber As Integer Dim settingDisplayAlerts As Boolean Dim dict As Object Dim wkbSource As Excel.Workbook Dim wks As Excel.Worksheet Dim filepath As String Dim code As String * 4 Dim wkbDestination As Excel.Workbook Dim varKey As Variant Dim sourceFolder As String Dim destinationFolder As String '------------------------------------------------------------------ 'Change [SheetsInNewWorkbook] setting of Excel.Application object to 'create new workbooks with a single sheet only. With Excel.Application settingDisplayAlerts = .DisplayAlerts settingSheetsNumber = .SheetsInNewWorkbook .SheetsInNewWorkbook = 1 .DisplayAlerts = False .ScreenUpdating = False End With Set dict = VBA.CreateObject("Scripting.Dictionary") sourceFolder = "C:\Users\ThomasK\Desktop\Test\" destinationFolder = "C:\Users\ThomasK\Desktop\" filepath = Dir(sourceFolder) 'Loop through each Excel file in folder Do While filepath <> "" If VBA.Right$(filepath, 5) = ".xlsx" Then Set wkbSource = Excel.Workbooks.Open(sourceFolder & filepath) Set wks = wkbSource.Worksheets(1) code = VBA.Left$(wkbSource.Name, 4) 'If this code doesn't exist in the dictionary yet, add it. If Not dict.exists(code) Then Set wkbDestination = Excel.Workbooks.Add wkbDestination.Worksheets(1).Name = TO_DELETE_SHEET_NAME Call dict.Add(code, wkbDestination) Else Set wkbDestination = dict.Item(code) End If Call wks.Copy(Before:=wkbDestination.Worksheets(1)) wkbDestination.Worksheets(1).Name = VBA.Mid$(filepath, 6) Call wkbSource.Close(False) End If filepath = Dir Loop 'Save newly created files. For Each varKey In dict.keys Set wkbDestination = dict.Item(varKey) 'Remove empty sheet. Set wks = Nothing On Error Resume Next Set wks = wkbDestination.Worksheets(TO_DELETE_SHEET_NAME) On Error GoTo 0 If Not wks Is Nothing Then wks.Delete Call wkbDestination.SaveAs(Filename:=destinationFolder & varKey & ".xlsx") Call wkbDestination.Close(True) Next varKey 'Restore Excel.Application settings. With Excel.Application .DisplayAlerts = settingDisplayAlerts .SheetsInNewWorkbook = settingSheetsNumber End With End Sub 

是否需要正则expression式来确定基金名称？