excel copy specified file in cel
2020-01-17 本文已影响0人
穹之扉
Sub copyFile()
Dim name As String
Dim cell As Object
Dim count As Integer
Dim fullPathCollection As New Collection
For Each cell In Selection
count = count + 1
eachValue = cell.Value
Dim userPath As String
'location where file copy to
userPath = "C:\Users\zc12729\Downloads\test1\" + eachValue + "\"
'Traverse all files under the path
TraversePath userPath, fullPathCollection
'start copy file to specified location
startCopy fullPathCollection
Next cell
Debug.print count & " item(s) selected"
End Sub
Sub startCopy(fullPathCollection As Collection)
Debug.Print "start print full path"
For Each fullPath In fullPathCollection
tempFullPath = "C:\Users\zc12729\Downloads\test\" + Dir(fullPath)
Debug.Print fullPath + " to " + tempFullPath
FileCopy fullPath, tempFullPath
Next fullPath
End Sub
Sub TraversePath(path As String, fullPathCollection As Collection)
Dim currentPath As String, directory As Variant
Dim dirCollection As Collection
Set dirCollection = New Collection
currentPath = Dir(path, vbDirectory)
'Explore current directory
Do Until currentPath = vbNullString
Debug.Print currentPath
If Left(currentPath, 1) <> "." And _
(GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
dirCollection.Add currentPath
ElseIf Left(currentPath, 1) <> "." Then
fullPathCollection.Add path + currentPath
End If
currentPath = Dir()
Loop
'Explore subsequent directories
For Each directory In dirCollection
Debug.Print "---SubDirectory: " & directory & "---"
TraversePath path & directory & "\", fullPathCollection
Next directory
End Sub