Excel VBA - 移动文件语法

Question

请帮助将文件逐个复制到目标文件夹。我尝试了“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来保存源文件中的文件，但如果您需要删除它，最好使用其他方法。