提取文件夹中的所有文件名字并移动对应文件夹中

zjminy

提取文件夹中的所有名字如AC19C021CA0(F252)中的19C021 并放入D盘的19C021文件夹中，如没有这个文件夹，则新建


大神们帮帮忙。

ykcbf1100

请看附件。

3190496160

Sub 创建文件夹拷贝文件()
Set fso = CreateObject("Scripting.FileSystemObject")
lj = ThisWorkbook.Path & "\"
F = Dir(lj & "*.xls*")
Do While F <> ""
    If F <> ThisWorkbook.Name Then
        MC = Mid(F, 3, 6)
        WJJ = "D:\" & MC
        If Not fso.folderexists(WJJ) Then fso.CreateFolder WJJ
        fso.copyfile lj & F, WJJ & "\"
    End If
F = Dir
Loop
Set fso = Nothing
MsgBox "ok!"
End Sub

3190496160