How to copy/save file

[aymanm]

Hello,
I'm trying to use a macro to copy and save an Excel file from one directory to another. I can do it but only if I open the file first and then Save As...

Thanks!

 

[Ralajer]

Below are two approaches to duplicated the file that don't require the workbook to open or be visible during the operations

This just copies the file using the FileCopy Function there is some limited error and overwrite handling.

Sub copyFile()
    Dim sourceFile As String
    Dim DestFile As String
    Dim msg As String
    
    sourceFile = "D:\Test\Test.xls"
    DestFile = "D:\Test\Test\Test2.xls"
    
    '// Check if source file doesn't exist
    If Dir(sourceFile) = "" Then
        msg = "Source not found" & vbCr & " • " & sourceFile
    End If
    If Dir(DestFile) <> "" Then
        msg = msg & vbCr & "Destination file already Exists" & vbCr & " • " & DestFile
    End If
    If Len(msg) = 0 Then
        FileCopy sourceFile, DestFile
    Else
        MsgBox msg
    End If
End Sub

The below opens a the source workbook in a new instance of excel that runs in the background and saves it to a new path. Then closes it everything.

Sub CopyByOpening()

    Dim bgExcel As New Excel.Application
    Dim wb As Workbook
    
    Dim sourceFile As String
    Dim DestFile As String

    bgExcel.Visible = False
    
    sourceFile = "D:\Test\Test.xls"
    DestFile = "D:\Test\Test\Test3.xls"
    
    Set wb = bgExcel.Workbooks.Add(sourceFile)
    wb.SaveCopyAs DestFile
    wb.Close SaveChanges:=False
    bgExcel.Quit

End Sub

Of course be careful when doing file operations progamatically as many times things can be overwritten without prompting for confirmation. Be sure to back up and test.

 

[aymanm]

That works .. thank you!

 

[eyong123]

Hello Ral,

I wish to copy a workbook while I am working with it then save copy in the same or different location with part of the name coming from a cell in the active workbook: here is my code and it gives runtime error, pls help me out

Sheets("SET UP").Select
Range("Q2") = Filename


Dim bgExcel As New Excel.Application
Dim wb As Workbook

Dim sourceFile As String
Dim DestFile As String

bgExcel.Visible = False

sourceFile = "C:\EEE\Fab 1& 2 Daily OEE Report WK.xls"
DestFile = "C:\EEE\Fab 1& 2 Daily OEE Report WK" & Cells(2, 17).Text & ".xls"
'Look to see if file already exists, don't want to over-write it
If Dir(DestFile) <> "" Then
MSG1 = MsgBox(" The File " + DestFile + " Already Exists", vbYesNo, "Do you want to replace the file ?")



If MSG1 = vbYes Then

Set wb = bgExcel.Workbooks.Add(sourceFile)
wb.SaveCopyAs DestFile
wb.Close SaveChanges:=False
bgExcel.Quit
MsgBox "Copied the file"


Else
Exit Sub
End If
End If

 

[Ralajer]

Been busy the last few days but this might work if you haven't already figured it out on your own. Slightly more general not relying on the active workbook's path to be hard coded. It will save the copy in the same directory that can be changed but that is problematic as you have to be sure the destination directory exists first or code to verify it does.

Sub copyActiveWorkBook()
    
    Dim wb As Workbook
    Dim ActiveWB As Workbook
    
    Dim srcFile As String
    Dim DestFile As String
    Dim NameSuffix As String
    Dim overWriteResponse As Integer
    Dim extPos As Integer
    
    Set ActiveWB = ActiveWorkbook
    
    NameSuffix = ActiveWB.Sheets("SET UP").Range("Q2")
    srcFile = ActiveWB.FullName
    
    
    Dim bgExcel As New Excel.Application
    bgExcel.Visible = False
    
    extPos = InStrRev(srcFile, ".")
    '// Insert the contents of Q2 at the end of existing file name
    DestFile = Left(srcFile, extPos - 1) & NameSuffix & Mid(srcFile, extPos)

    'Look to see if file already exists, don't want to over-write it
    If Dir(DestFile) <> "" Then
        overWriteResponse = MsgBox(" The File " + DestFile + " Already Exists", vbYesNo, "Do you want to replace the file ?")
        '\\ Simplified the test exiting sub if the file is not to be overwritten
        If overWriteResponse <> vbYes Then Exit Sub
    End If
    
    Set wb = bgExcel.Workbooks.Add(srcFile)
    wb.SaveCopyAs DestFile
    wb.Close SaveChanges:=False
    bgExcel.Quit
    MsgBox "Copied the file"
    
End Sub

 

[eyong123]

mANY THANKS MATE.