Question

请帮助将文件逐个复制到目标文件夹的代码。我尝试使用＆＃34; for Each循环，但它将所有文件一次复制到目标文件夹。我是vba的新手，如果有人能为我破解代码，我会很有帮助。提前致谢。这是我设法提出的代码。

我得到运行时错误53，找不到文件，e突出显示以下语法。

FSO.movefile Source:="C:\Users\wazeer.ahamed\Documents\Outlookemails_Macro\" & Fname, Destination:="C:\Users\wazeer.ahamed\Documents\TcktIDfolder\" & Fname

Sub Example1()

'Extracting file names Dim objFSO As Object Dim objFolder As Object Dim newobjFile As Object    
Dim lastID As Long Dim myRRange As Range Dim Maxvalue As Integer    
Dim sFolder As String Dim dFolder As String


Sub Example1()

'Extracting file names
Dim FSO
Dim objFolder As Object
Dim newobjFile As Object
Dim FromDir As String
Dim ToDir As String    

Dim lastID As Long
Dim myRRange As Range
Dim Maxvalue As Integer    
Dim Fname As String                    

FromDir = "C:\Users\wazeer.ahamed\Documents\Outlookemails_Macro\"
ToDir = "C:\Users\wazeer.ahamed\Documents\TcktIDfolder\"    
Fname = Dir(FromDir)

If Len(FromDir) = 0 Then
    MsgBox "No files"
    Exit Sub
End If    

Set myRange = Worksheets("Sheet1").Range("C:C")    
Maxvalue = Application.WorksheetFunction.Max(myRange)    
lastID = Maxvalue

'finding the next availabe row    
erow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'Extracting file names

'Create an instance of the FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = FSO.GetFolder("C:\Users\wazeer.ahamed\Documents\Outlookemails_Macro")

'loops through each file in the directory and prints their names and path        
For Each newobjFile In objFolder.Files

     'print file name       
    Cells(erow, 1) = Fname    

    'print file path
    Cells(erow, 2) = newobjFile.Path

    'PrintUniqueID
    Cells(erow, 3) = lastID + 1

    FSO.movefile Source:="C:\Users\wazeer.ahamed\Documents\Outlookemails_Macro\" & Fname, Destination:="C:\Users\wazeer.ahamed\Documents\TcktIDfolder\" & Fname     
    Cells(erow, 5) = "file succesfully copied"                   
Next newobjFile        

Set FSO = Nothing
Set newobjFile = Nothing
Set objFolder = Nothing             

End Sub

Answer 1

我认为如果你使用自己的excel文件，代码可以更简单和动态。

使用“A1”范围放置源文件夹。
使用“B：B”范围来放置文件名。
使用“C：C”范围连接前一个列。
使用“D1”范围放置目标文件夹。

Sub copyFiles()
'Macro for copy files
'Set variable
Dim source As String
Dim destination As String
Dim x As Integer
Dim destinationNumber As Integer

destinationNumber = WorksheetFunction.CountA(ThisWorkbook.Sheets("Sheet1").Range("C:C"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Create the folder if not exist
If Dir(ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Sheet1").Range("D1"), 16) = "" Then
    MkDir ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Sheet1").Range("D1")
End If

'Run the loop to copy all the files
For x = 1 To destinationNumber
    source = ThisWorkbook.Sheets("Sheet1").Range("C" & x)
    destination = ThisWorkbook.Sheets("Sheet1").Range("D1")
    FileCopy source, destination
Next x

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

使用此功能，您可以随时更改文件夹的路径和文件名。我已经使用FileCopy来保存源文件，但如果你需要删除它，最好使用其他方法。

Excel VBA - movefile语法

1 个答案: