Excel VBA-Movefile語法

Question

請提供代碼幫助將文件一一復制到目標文件夾。 我嘗試了“ for Each循環，但它一次將所有文件復制到目標文件夾。我是vba的新手，如果有人可以為我破解代碼，這將非常有幫助。在此先感謝。這是我管理的代碼提出來。

我遇到運行時錯誤53，找不到文件，突出顯示以下語法。

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