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來保存源文件中的文件，但如果您需要刪除它，最好使用其他方法。