2016-11-30 11 views
0

ファイルをコピー先フォルダに1つずつコピーするコードを助けてください。私は "for Eachループを試しましたが、一度にすべてのファイルをコピー先フォルダにコピーしています。私はvbaを初めて使用していて、誰かが私のコードを解読できれば助かります。思い付く。Excel VBA - movefileの構文

私は、実行時エラー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  
+0

ファイル名にFnameを使用していますが、Fnameはprocの先頭にある 'Dir'からの戻り値で初期化されます(C:\ Users \ wazeer.ahamed \ Documents \ Outlookemails_Macro \)。 –

答えて

0

私はあなたと遊ぶ場合は、コードをよりシンプルかつダイナミックなことができると思い

  • "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を使用しましたが、削除する必要がある場合は、他の方法を使用する方が良いです。