|
- Sub aa()
- Dim ar, i&, ph$, ph1$, d As Object, d1 As Object
- Set d1 = CreateObject("scripting.dictionary")
- MsgBox "请选择需要复制文件的文件夹路径"
- With Application.FileDialog(msoFileDialogFolderPicker)
- If .Show = -1 Then
- ph = .SelectedItems(1)
- Else
- Exit Sub
- End If
- End With
- MsgBox "请选择需要存放文件文件夹路径"
- With Application.FileDialog(msoFileDialogFolderPicker)
- If .Show = -1 Then
- ph1 = .SelectedItems(1)
- Else
- Exit Sub
- End If
- End With
- With Sheet1
- ar = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(3))
- For i = 1 To UBound(ar)
- d1(ar(i, 1)) = ""
- Next
- End With
- With CreateObject("scripting.filesystemobject")
- For Each d In .getfolder(ph).Files
- If d1.exists(Split(d.Name, ".")(0)) Then
- .copyfile ph & "" & d.Name, ph1 & "" & d.Name
- End If
- Next
- End With
- Set d1 = Nothing
- End Sub
复制代码 |
|