我必须手动移动30,000+个文件,并试图弄清楚VBA如何做到这一点。我设法通过VBA目录名称提取来获取所有文件名,但是在传输过程中却遇到了困难。
我的Excel文件如下:
A列-“文件名”
示例->“文件标题” .pdf(可能是其他文件扩展名)
B列-“源文件夹目录”
示例-> C:\ Users \“ user” \ folder \ folder \ folder \ EFT \ Countries_COMPLETE \ Wave 3 \ folder \ SOURCEFOLDER
列C-“目标文件夹目录”
示例-> C:\ Users \“ user” \ folder \ folder \ folder \ EFT \ Countries_COMPLETE \ Wave 3 \ folder \ folder \ DESTINATIONFOLDER
即使我的所有对象都已指定,我仍继续获得运行时1004。
Sub FileTranspose()
Dim c As Excel.Range
Dim strName As String
Dim strDir As String
With Worksheets("Sheet1")
'// Loop from row 2 to last used cell in Col A
For Each c In **Sheet1**.Range("A2").Resize(**Sheet1**.Range("A" & Rows.Count).End(xlUp).Row - 1)
'// If the cell contains any text...
If c.Value <> vbNullString Then
'// And the 2 cells to the right contain some text...
If c.Offset(0, 1).Value <> vbNullString And c.Offset(0, 2).Value <> vbNullString Then
'// Make up the full source file name, includes path.
strName = c.Offset(0, 1).Value & IIf(Right$(c.Offset(0, 1).Value, 1) <> "\", "\", vbNullString) & c.Value
'// Same for destination Directory name
strDir = c.Offset(0, 2).Value & IIf(Right$(c.Offset(0, 2).Value, 1) <> "\", "\", vbNullString)
'// If the file to copy exists...
If Dir(strName) <> vbNullString Then
'// And the Destination directory exists...
If Dir(strDir, vbDirectory) <> vbNullString Then
'// Copy it.
FileCopy strName, strDir & c.Value
'// Delete
Kill strName
End If
End If
End If
End If
Next
End With
End Sub
目标是自动拉起B列,在A列中查找文件,然后插入C列。
复制后,我想从原始文件夹中删除文件。