Create new excel files, Save backup of excel file
 

Hello,

I have 2 questions:

I have an excel worksheet with 4 sections. I get my data from 4 users.
I created 4 files (one file for user). Each file contains user's
section.
My problem is that I update my worksheet frequently and I want to
automate the creation of users files. How can I do it using VBA ?

I want to backup my excel file (and all the files within its directory)
to a new folder.
How can I do this using VBA ?

Thank you
Gil D.

Create new excel files, Save backup of excel file
 

I want to backup my excel file (and all the files within its directory)
to a new folder.
How can I do this using VBA ?

Function BackUp(srcFolder As String, DestFolder As String, createFolder
As Boolean)
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFolderPath As String

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(srcFolder)
Set objFiles = objFolder.Files

If createFolder Then
objFS.createFolder DestFolder
End If

For Each objF1 In objFiles
FileCopy srcFolder & "\" & objF1.Name, DestFolder & "\" &
objF1.Name
Next
End Function



I want to
automate the creation of users files. How can I do it using VBA ?


Function createXL()
Dim appXL As Object
Dim wrkBuk As Object


Set appXL = CreateObject("Excel.Application")
appXL.Visible = True
Set wrkBuk = appXL.Workbooks.Add

appXL.Cells(1,1).Value = Sheets("Sheet1").Cells(1,1).Value


wrkBuk.Saveas "C:\NewBuk.xls"
wrkBuk.Close
Set appXL = nothing
End Function

Hope this will help.

Create new excel files, Save backup of excel file
 

Hello,

Thank you for your help.

One more problem:

Function BackUp(...) causes run time error 70 on:
FileCopy srcFolder & "\" & objF1.Name, DestFolder & "\" & objF1.Name
It creates destination folder but does not copy files from source
folder into it..
How can I solve this ?

Function createXL() works great.

Thank you for your help.
Gil D.

Create new excel files, Save backup of excel file
 

the files that you will going to backUp is opened, that's why it has
a runtime error.

Close first all the files in that folder and run again the BackUp
function.


HTH

Create new excel files, Save backup of excel file
 

Hello,

Thank you for your answer.

I want that my user will be able to backup my application within excel
(My application is an excel file).
I understand (from your answer) that it is not possible.
Should I create another excel workbook with backup function in order to
do this ?

Thank you
Gil D.

Create new excel files, Save backup of excel file
 

No need to create another xls.


Function BackUp(srcFolder As String, DestFolder As String, createFolder
As Boolean)
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFolderPath As String

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(srcFolder)
Set objFiles = objFolder.Files


If createFolder Then
objFS.createFolder DestFolder
End If


For Each objF1 In objFiles
If objF1.Name < ThisWorkbook.Name Then
FileCopy srcFolder & "\" & objF1.Name, DestFolder & "\" &
objF1.Name
Else
ThisWorkbook.SaveAs DestFolder & "\" & ThisWorkbook.Name
End If
Next
End Function

Create new excel files, Save backup of excel file
 

No need to create another xls.


Function BackUp(srcFolder As String, DestFolder As String, createFolder
As Boolean)
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFolderPath As String

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(srcFolder)
Set objFiles = objFolder.Files


If createFolder Then
objFS.createFolder DestFolder
End If


For Each objF1 In objFiles
if objF1.Name < ThisWorkbook.Name then
FileCopy srcFolder & "\" & objF1.Name, DestFolder & "\" &
objF1.Name
else
ThisWorkbook.SaveAs DestFolder & "\" & ThisWorkbook.Name
End if
Next
End Function

Create new excel files, Save backup of excel file
 

Try

Sub CreateBackup()
Dim FName As String
If Right(ActiveWorkbook.FullName, 4) < ".xls" Then
'not saved. get out
Exit Sub
End If
FName = Left(ActiveWorkbook.FullName,
Len(ActiveWorkbook.FullName) - 4)
FName = FName & ".xlk"
On Error Resume Next
Kill FName
On Error GoTo 0
ActiveWorkbook.SaveCopyAs FName

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com


wrote in message
oups.com...
No need to create another xls.


Function BackUp(srcFolder As String, DestFolder As String,
createFolder
As Boolean)
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFolderPath As String

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(srcFolder)
Set objFiles = objFolder.Files


If createFolder Then
objFS.createFolder DestFolder
End If


For Each objF1 In objFiles
If objF1.Name < ThisWorkbook.Name Then
FileCopy srcFolder & "\" & objF1.Name, DestFolder & "\"
&
objF1.Name
Else
ThisWorkbook.SaveAs DestFolder & "\" &
ThisWorkbook.Name
End If
Next
End Function

Create new excel files, Save backup of excel file
 

Hello,

Thank you very much for your help.

Gil D.