如何根据单元格值在复制文件后创建对应文件夹

现有VBA代码可实现指定文件的复制操作，需小幅修改：完成文件复制时，根据表格中CODE列的单元格值创建对应文件夹，并将同一CODE值的文件归类至该文件夹中。示例中需生成WSO.24和WSO.23两个文件夹，分别存放3个和2个图片文件。

表格数据 #

修改后的代码 #

核心修改点：

• 按当前行CODE值拼接目标子文件夹路径
• 自动创建不存在的CODE子文件夹
• 将文件复制到对应CODE的子文件夹内

Sub copyFilesByCode()
  Dim sh As Worksheet, lastR As Long, arrA, i As Long, k As Long
  Dim fileD As FileDialog, strDestFold As String, FSO As Object
  Dim codeFolderPath As String, currentCode As String
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.Rows.Count).End(xlUp).Row ' 获取A列最后一行数据行号
  arrA = sh.Range("A2:E" & lastR).Value2 ' 将数据存入数组提升遍历效率
  Set FSO = CreateObject("Scripting.FileSystemObject")
  
  ' 选择目标根文件夹
  With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择目标根文件夹！"
        .AllowMultiSelect = False
        If .Show = -1 Then
            strDestFold = .SelectedItems.Item(1) & "\" ' 统一路径分隔符格式
        End If
  End With
  If strDestFold = "" Then Exit Sub ' 未选择文件夹则直接退出
  
  For i = 1 To UBound(arrA)
     If UCase(arrA(i, 5)) = "V" Then ' 仅处理E列为"V"的文件
        currentCode = arrA(i, 3) ' 获取当前行的CODE值
        ' 拼接CODE对应的子文件夹完整路径
        codeFolderPath = strDestFold & currentCode & "\"
        
        ' 检查子文件夹是否存在，不存在则创建
        If Not FSO.FolderExists(codeFolderPath) Then
            FSO.CreateFolder codeFolderPath
        End If
        
        If FSO.FileExists(arrA(i, 1)) Then ' 校验源文件路径有效性
            ' 将文件复制到对应CODE的子文件夹，允许覆盖已存在文件
            FSO.COPYFILE arrA(i, 1), codeFolderPath, True
            k = k + 1
        Else
            MsgBox arrA(i, 1) & " 文件未找到。" & vbCrLf & _
                        "请检查路径拼写并修正！", vbInformation, _
                        "文件不存在..."
        End If
     End If
  Next i
  MsgBox "已复制 " & k & " 个文件到 " & strDestFold & " 下的对应CODE文件夹中", , "完成..."
End Sub

内容的提问来源于stack exchange，提问作者roy