VBA使用Excel对象中列出的完整路径和文件名复制文件 [英] VBA to Copy files using complete path and file names listed in Excel Object

问题描述

我正在写一个宏，需要：

I am writing a macro that needs to:

1从文件夹的特定文件夹和子文件夹获取文件列表（大约10k行），并将其放入在A列中具有文件名和扩展名somefile.ext，在列C中具有完整文件路径（例如，D：\2014\Client Name\Misc\somefile.ext）的Excel工作簿（Sheet1）

1 Get file list (around 10k rows) from a specific folder and subfolders of that folder and post it into an excel workbook (Sheet1) with File name and extension "somefile.ext" in column A and complete file path in column C (eg. D:\2014\Client Name\Misc\somefile.ext)

2过滤掉符合我要求的文件，并删除不需要的行。

2 Filter out the files that meet my requirement and delete rows that do not.

3使用C列的完整路径将这些列出的文件复制到一个新目录，但保持子文件夹结构，以便：

3 use the complete path from column C to copy those listed files into a new directory but maintaining the subfolder structure so that:

D：\2014\Client Name\Misc \somefile.ext变成D：\2015\Client Name\Misc \somefile.ext。

D:\2014\Client Name\Misc\somefile.ext becomes D:\2015\Client Name\Misc\somefile.ext .

在新文件夹中已存在路径（使用此宏创建），但文件不。

Where the path already exists (created with this macro) in the new folder but the file does not.

现在我已经自己做了＃3。我被困在复制这些文件，我只是缺乏专有技术。

Now I have made it up to #3 on my own. I am stuck at copying those files, I simply lack the know-how. I am asking you guys for help.

以下代码只适用于但不包括第3点：

Here is the code that works up to but not including point 3:

Option Explicit
Sub ListFiles()

Dim objFSO As Scripting.FileSystemObject
Dim objTopFolder As Scripting.folder
Dim strTopFolderName As String

Range("A1").Value = "File Name"
Range("B1").Value = "File Type"
Range("C1").Value = "File Patch"

strTopFolderName = "D:\2014"

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objTopFolder = objFSO.GetFolder(strTopFolderName)

Call RecursiveFolder(objTopFolder, True)

Columns.AutoFit

End Sub

Sub RecursiveFolder(objFolder As Scripting.folder, _
IncludeSubFolders As Boolean)

Dim objFile As Scripting.file
Dim objSubFolder As Scripting.folder
Dim NextRow As Long

NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each objFile In objFolder.Files
    Cells(NextRow, "A").Value = objFile.Name
    Cells(NextRow, "B").Value = objFile.Type
    Cells(NextRow, "C").Value = objFile.path
    NextRow = NextRow + 1
Next objFile

If IncludeSubFolders Then
    For Each objSubFolder In objFolder.SubFolders
        Call RecursiveFolder(objSubFolder, True)
    Next objSubFolder
End If
End Sub
Sub delete_rows()

Dim lastrow As Long
Dim row_index As Long

Application.ScreenUpdating = False
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
If InStr(Cells(row_index, "A").Value, "Processing") = 0 Then
Cells(row_index, "A").EntireRow.Delete
End If
Next
Columns.AutoFit
Application.ScreenUpdating = True
End Sub

推荐答案

我认为这会做你想要的（你可以删除/ K使命令窗口消失。）

I think this will do what you want (You can remove the /K to make the command window go away).

  Call Shell("""cmd"" /K copy " & _
    "D:\2014\Client Name\Misc\somefile.ext " & _
    "D:\2015\Client Name\Misc\somefile.ext", vbNormalFocus)

b $ b

编辑：Tim的回答（作为注释）更直接。我认为一个shelled命令可以使用通配符，这可能是有用的，我不认为你可以使用FileCopy。

Tim's answer (as a comment) is much more straightforward. I was thinking that a "shelled" command could use wildcards, which may be useful and I don't think you can do that using FileCopy.

FileCopy source, destination

source：必需。指定要复制的
文件的名称的字符串表达式。源可以包括目录或文件夹，以及
驱动器。 destination：必需。指定
目标文件名的字符串表达式。目标可以包括目录或文件夹，以及
驱动器。

source: Required. String expression that specifies the name of the file to be copied. The source may include directory or folder, and drive. destination: Required. String expression that specifies the target file name. The destination may include directory or folder, and drive.

这篇关于VBA使用Excel对象中列出的完整路径和文件名复制文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！