Cut Paste files in to another folder

[Abhijeet]

Hi

I have files in one folder i want move that files & also rename that files & then Cut all those files paste into given path that folder. please give me macro

 

[Luke M]

1. Where is the folder?
2. What are we renaming them to?
3. Where are moving them to?

As standard, please give complete information when you ask a question. Writing macros, as you should know, requires specific information on layout and wording. It's very difficult when dealing with vaguearies.

 

[Abhijeet]

Hi
I have this code Please give me in Office 2003 version file Please give me modified macro with rename the file name

Function file_exists(fl_path As String) As String
    If Dir(fl_path) <> "" And fl_path <> "" Then
        file_exists = "Exists"
    Else
        file_exists = "Not Exists"
    End If
End Function
Function folder_exists(fld_path As String) As String
    If Len(Dir(fld_path, vbDirectory)) <> 0 And fld_path <> "" Then
        folder_exists = "Exists"
    Else
        folder_exists = "Not Exists"
    End If
 
End Function
Sub move_file()
    Dim filenm As String
    Dim newfolder As String
    Dim newpath As String
    Dim fld As Object
 
    ' old file name
    filenm = "C:\Documents and Settings\user\Desktop\sample_1.xlsm"
    'new File Name
    newfolder = "C:\Documents and Settings\user\Desktop\ashish" ' please add "\" as the end
    ' new path
    ' add \ at the end of folder
    If VBA.Right(newfolder, 1) <> "\" Then newfolder = newfolder & "\"
    ' new path of file
    newpath = newfolder & VBA.Right(filenm, Len(filenm) - InStrRev(filenm, "\"))
 
    ' add some control check to avoid crashes
 
    ' check if file exists which we want to move
    If file_exists(filenm) <> "Exists" Then
        MsgBox "File does not exists so can not be moved ", vbInformation, "Note:"
        Exit Sub
    End If
 
    ' check if file already exits at destination folder
    If file_exists(newpath) = "Exists" Then
        MsgBox "File already exists at destination folder so can not be moved ", vbInformation, "Note:"
        Exit Sub
    End If
    ' check if  destination folder exists
    If folder_exists(newfolder) <> "Exists" Then
        MsgBox "Destination folder does not exists. Please create the folder first", vbInformation, "Note:"
        Exit Sub
    End If
 
    'move it finally
    Set fld = CreateObject("Scripting.FileSystemObject")
    fld.Movefile filenm, newfolder
End Sub

Edit by mod: Added Code tags

 

[Luke M]

The code you posted uses late-binding, so I don't think office version should matter. Can you elaborate on what doesn't work currently? Or, does the code actually work just fine, and what you really need is just to change the file name?
Also, you still have not stated what the file name needs to be changed to.

 

[Abhijeet]

Hi Luke M
In this macro i want additionally add Cut paste the files from 1 folder to another

 

[Luke M]

Again, still didn't answer question about what to rename file.
Here's your above code, modifed to loop over a folder. Change the 2 DIR lines as needed to filter on specific files. I've attempted to flag the lines that you need to pay attention to.

Option Explicit


Function file_exists(fl_path As String) As String
    If Dir(fl_path) <> "" And fl_path <> "" Then
        file_exists = "Exists"
    Else
        file_exists = "Not Exists"
    End If
End Function
Function folder_exists(fld_path As String) As String
    If Len(Dir(fld_path, vbDirectory)) <> 0 And fld_path <> "" Then
        folder_exists = "Exists"
    Else
        folder_exists = "Not Exists"
    End If

End Function
Sub move_file()
    Dim filenm As String
    Dim destFold As String
    Dim sourceFold As String
    Dim fld As Object
    Dim newPath As String

'CHANGE THESE
    'Folder files are in currently:
    sourceFold = "C:\My Documents\"
    'Folder we are moving to:
    destFold = "C:\Some Other Folder\"
   
   
   
   ' add \ at the end of folders
   If VBA.Right(sourceFold, 1) <> "\" Then sourceFold = sourceFold & "\"
   If VBA.Right(destFold, 1) <> "\" Then destFold = destFold & "\"
   
   
   ' check if  destination folder exists
   If folder_exists(sourceFold) <> "Exists" Then
        MsgBox "Destination folder does not exists. Please create the folder first", vbInformation, "Note:"
        Exit Sub
    End If
   
   
    'Find our files, in this example, filtering for txt files
'CHANGE THIS
    filenm = Dir(sourceFold & "*.txt")

    Set fld = CreateObject("Scripting.FileSystemObject")

    Do While filenm <> ""
        ' new path of file
        newPath = destFold & VBA.Right(filenm, Len(filenm) - InStrRev(filenm, "\"))
       
        ' check if file already exits at destination folder
        If file_exists(newPath) <> "Exists" Then
            fld.movefile filenm, destFold
            'Rename the file:
'CHANGE THIS
            Name destFold & filenm As destFold & "MOVED" & filenm
        End If
'CHANGE THIS
        filenm = Dir(sourceFold & "*.txt")
    Loop
    Set fld = Nothing
End Sub

 

[Abhijeet]

Hi Luke M
Macro which i am provide is getting file names & rename if we provide the name then.I want after rename cut paste files & paste in another folder

 

[Abhijeet]

I have rename files macro. can just add in this macro to cut paste the files from one folder to another

 

[Luke M]

Abhijeet,

The code I posted above is a complete solution, performing the renaming and moving, as originally requested. In this thread, like several of your other threads, you started with a bare minimum of provided information, and slowly gave more information, often information that invalidates the solution given. Instead of first posting a few sentences, and then later posting the code, and then later posting the actual workbook, START by posting the workbook w/ code and a complete description of what you want! This will save so much more time for everyone.

For your problem, the parts you need to know about are:

• Looping through files
• Renaming files
• Moving files

You now have adequate information between your existing code and what I've supplied to be able to put the pieces together yourself. Why don't you take a few moments to look over the code, learn to understand it, and take a crack at changing it around to solve your problem.