Excel VBA - movefile语法

Question

请帮助将文件逐个复制到目标文件夹的代码。我试着用"for每个循环“，但是它是一次将所有文件复制到目标文件夹。我对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来保存源代码中的文件，但是如果需要删除，最好使用其他方法。