在VBA中将特定文件列表从文件夹移动到文件夹

时间:2019-10-02 17:47:01

标签: excel vba

我必须手动移动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列。

复制后,我想从原始文件夹中删除文件。

0 个答案:

没有答案