|
发表于 2016-6-13 10:42
|
显示全部楼层
本楼为最佳答案
- Sub xx()
- Dim dc, MyName$, MyPath$, objShell, fso As Object
- Set dc = CreateObject("Scripting.Dictionary")
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set objShell = CreateObject("Shell.Application")
- MyPath = ThisWorkbook.Path & ""
- MyName = Dir(MyPath, vbDirectory)
- If Sheet1.[D1] = "" Then Exit Sub
- Do While MyName <> ""
- If MyName <> "." And MyName <> ".." Then
- If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
- dc.Add (MyPath & MyName & ""), Replace(MyName, "B", "")
- End If
- End If
- MyName = Dir
- Loop
- Set objFolder = objShell.BrowseForFolder(0, "选择文件目录", 0, 0)
- If Not objFolder Is Nothing Then
- MyPath = objFolder.self.Path
- Else
- MyPath = ""
- End If
- If MyPath <> "" Then
- For Each k In dc.keys
- fso.CopyFolder k & Sheet1.[D1], MyPath & "\A" & dc(k)
- Next
- End If
- End Sub
复制代码 |
评分
-
查看全部评分
|