VBA - Move Old Version of File to Archive Folder and Save New Version in Same Filepath

[dwhitey1124]

Hi, I am using the below code in a large macro. I can't get it to work exactly. I am trying to have the old version of the file (which is the file being opened) moved from the current filepath to an archive folder. I would then save a new version of the folder in the current filepath. The closest I got to was saving the old version in the archive folder but was unable to delete the older version from the current filepath or save a new version to the current filepath. Ideally, VBA would cut the old file and paste it into the archive folder. And then save a new version of the file in the current filepath.

Any help would be much appreciated.

Thanks.

Dim FName           As String
    Dim FPath           As String
     
    FPath = Sheet1.Range("C2").text
    FName = Sheet1.Range("BQ1").text
    ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
    
    
    Sheet1.Range("BQ1:BQ10").Calculate
    Sheet1.Range("o1:V1").Calculate

'You can use this to delete one xls file in the folder Test
Sheet1.Range("BQ1").Copy
Sheet1.Range("BQ10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
On Error Resume Next
   
   Dim FName2           As String
    Dim FPath2           As String
     
    FPath2 = ThisWorkbook.Path
    FName2 = Sheet1.Range("BQ10").text
    Kill FPath2 & "\" & FName2
     On Error GoTo 0

Dim FName3           As String
    Dim FPath3           As String
     
    FPath3 = ThisWorkbook.Path
    FName3 = Sheet1.Range("BQ1").text
    ThisWorkbook.SaveAs Filename:=FPath3 & "\" & FName3

 

[Worf]

Hi

See if this is useful:

Sub Move_Rename_Copy_Delete()
On Error Resume Next
FileCopy "c:\pub\source\speedometer.xlsx", "c:\pub\dest\speedometer.xlsx"   ' copy file
Name "c:\pub\source\rangesfiles.xlsm" As "c:\pub\dest\newrange.xlsm"      ' move & rename
Kill "c:\pub\dest\temp.csv"         ' Caution: cannot be undone!
On Error GoTo 0
End Sub

 

[dwhitey1124]

Thanks for your help. I'm having some trouble tweaking it for my purposes.

I have all the file paths in cells C2:C4. They are dynamic. Below are what they are currently.

I would like to move C2 to C3. And then save C4 to the same folder where C2 was.

C2
"J:\Client\Member Institutions\Marist College\2015\Marist Pro Forma 03 05 15.xlsm"

C3
"J:\Client\Member Institutions\Marist College\2015\Old Pro Forma\Marist Pro Forma 03 05 15.xlsm"

C4
"J:\Client\Member Institutions\Marist College\2015\Marist Pro Forma 03 06 15.xlsm"

FileCopy Sheet1.Range("C2").text, Sheet1.Range("C3").text   ' copy file
Name Sheet1.Range("C2").text As Sheet1.Range("C4").text      ' move & rename
Kill Sheet1.Range("C2").text         ' Caution: cannot be undone!

Hi

See if this is useful:

Sub Move_Rename_Copy_Delete()
On Error Resume Next
FileCopy "c:\pub\source\speedometer.xlsx", "c:\pub\dest\speedometer.xlsx"   ' copy file
Name "c:\pub\source\rangesfiles.xlsm" As "c:\pub\dest\newrange.xlsm"      ' move & rename
Kill "c:\pub\dest\temp.csv"         ' Caution: cannot be undone!
On Error GoTo 0
End Sub

 

[Worf]

Is this better?

Sub with_formulas()


' column C -> complete path
' column D -> folder path
' column E -> file name


Range("d2").Formula = "=LEFT(c2,FIND(""@"",SUBSTITUTE(c2,""\"",""@"",LEN(c2)-LEN(SUBSTITUTE(c2,""\"","""")))))"
Range("e2").Formula = "=TRIM(RIGHT(SUBSTITUTE(c2,""\"",REPT("" "",LEN(c2))),LEN(c2)))"
Range("d2:e2").AutoFill Range("d2:e4"), xlFillDefault
FileCopy Range("c2"), Range("d3") & Range("e2")     ' c2 to d3 folder, with e2 name
FileCopy Range("c4"), Range("d2") & Range("e4")     ' c4 to d2 folder, with e4 name


End Sub

 

[dwhitey1124]

Thanks for giving it another shot, but I do not follow what you are trying to do. I have everything already set up in C2:C4 as I previously described. These cells contain the full file paths and name for each sheet.

All I would like to do is reference the text in those cells. Let me know if you have any ideas.

Thanks again.

Is this better?

Sub with_formulas()


' column C -> complete path
' column D -> folder path
' column E -> file name


Range("d2").Formula = "=LEFT(c2,FIND(""@"",SUBSTITUTE(c2,""\"",""@"",LEN(c2)-LEN(SUBSTITUTE(c2,""\"","""")))))"
Range("e2").Formula = "=TRIM(RIGHT(SUBSTITUTE(c2,""\"",REPT("" "",LEN(c2))),LEN(c2)))"
Range("d2:e2").AutoFill Range("d2:e4"), xlFillDefault
FileCopy Range("c2"), Range("d3") & Range("e2")     ' c2 to d3 folder, with e2 name
FileCopy Range("c4"), Range("d2") & Range("e4")     ' c4 to d2 folder, with e4 name


End Sub

 

[Worf]

Thanks for giving it another shot, but I do not follow what you are trying to do. I have everything already set up in C2:C4 as I previously described. These cells contain the full file paths and name for each sheet.

All I would like to do is reference the text in those cells. Let me know if you have any ideas.

I have to go offline right now, but will be back tomorrow to explain what my code does...

 

[Worf]

Here is what I understood of your request:

- The file at c2 is to be copied to the folder that appears in c3.

- The file at c4 is to be copied to the folder that appears in c2.

- To accomplish that, the full path must be parsed into file name and folder.

- Column D will hold folder paths and column E will contain file names.

- Then, the code copies the files to their new locations. To remove files, just add a kill statement. I suggest you try the macro to see it working.

- If this is not it, please explain again…

 

[Worf]

Sub Copy_One()
Dim ws As Worksheet
Set ws = Sheets("MAIN")


' if the complete paths are already defined, do it like this:


FileCopy ws.Range("c2"), ws.Range("c3")


End Sub