PDA

View Full Version : VB Code for saving a workbook with duplication prevention



cbs81
01-14-2007, 10:27 PM
Hi, I have a question.... Im developing a cash reconciliation whereby a user saves a template into a directory... I have a Coversheet tab in this workbook where they select from a drop down box the following:

1) operator
2) month
3) the year

then the following code Creates a NEW workbook in the same directory and renames the workbook:

Cash Reconciliation " & oprtr$ & " " & mnth$ & " " & yr$

OK..... All good until a user in the following month selects the same:

1) operator
2) month
3) the year

as the month before... excel prompts the user if they want to overwrite the previously file.. if they accidently select YES.. then the file is overwritten..... What is the code and where do I put it if I want excel to prevent overwriting the file... perhaps to check in the directory if there is the same file, then prompt the user to SELECT A DIFFERENT:

1) operator
2) month
3) the year

Any other ideas???? the whole purpose is to prevent the user from overwriting the previously created file which may have data in it.....

I know it may be tricky so im hoping all you genious's can help me out here... thankyou heaps...

here is the code i got for saving the workbook but it doesnt work:






Private Sub CommandButton1_Click()
Dim wbpath$, oprtr$, mnth$, yr$
Dim Sht As Worksheet
' name new workbook according to file path to which original was saved
' and add Operator, Month, and Year to name
Application.ScreenUpdating = False
If Range("f24") = "-" Then
MsgBox "Operator name must be entered"
Exit Sub
End If
If Range("f26") = "-" Then
MsgBox "Month must be entered"
Exit Sub
End If
If Range("f27") = "-" Then
MsgBox "Year must be entered"
Exit Sub
End If
With Sheets("cover sheet")
oprtr$ = .Range("f24")
mnth$ = .Range("f26")
yr$ = .Range("f27")
End With
Sheets("Cover Sheet").Shapes("CommandButton1").Delete
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Cover Sheet" Then Sht.Visible = True
Next
Application.Run "rename_sheets"
Application.Run "hidefirstlast"
Dim fn As String
fn = Dir(ActiveWorkbook.Path & "\Cash Reconciliation " & oprts$ & _
" " & mnth$ & " " & yr$ & ".xls")
If Len(fn) Then
MsgBox "File already exists"
Exit Sub
End If
ThisWorkbook.SaveAs Application.ActiveWorkbook.Path & "\Cash Reconciliation " & _
oprtr$ & " " & mnth$ & " " & yr$ & ".xls"
Application.ScreenUpdating = True

If Range("f26") = "April" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "June" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "September" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "November" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "February" Then
Sheet36.Visible = False
Sheet35.Visible = False
Sheet1.Range("39:40").EntireRow.Hidden = True
End If

End Sub

Jacob Hilderbrand
01-14-2007, 11:57 PM
Try this function to test the path to see if the file exists or not.

Set a Reference to the Microsoft Scripting Runtime (Tools | References)


Option Explicit

Function FileExists(Path As String) As Boolean

Dim F As File
Dim FSO As New FileSystemObject

On Error Resume Next
Set F = FSO.GetFile(Path)
On Error GoTo 0

FileExists = Not F Is Nothing

Set F = Nothing
Set FSO = Nothing

End Function

cbs81
01-30-2007, 10:54 PM
Hi there, after careful integration of the following code, I still cant get this to work.... Could anyone please shed some light on this VB code:

Just reiterating the background to my problem
Im developing a cash reconciliation whereby a user saves a template into a directory... I have a Coversheet tab in this workbook where they select from a drop down box the following:

1) operator
2) month
3) the year

then the following code Creates a NEW workbook in the same directory and renames the workbook:

Cash Reconciliation " & oprtr$ & " " & mnth$ & " " & yr$

OK..... All good until a user in the following month selects the same:

1) operator
2) month
3) the year

as the month before... excel prompts the user if they want to overwrite the previously file.. if they accidently select YES.. then the file is overwritten..... What is the code and where do I put it if I want excel to prevent overwriting the file... perhaps to check in the directory if there is the same file, then prompt the user to SELECT A DIFFERENT:

1) operator
2) month
3) the year

Any other ideas???? the whole purpose is to prevent the user from overwriting the previously created file which may have data in it.....

I know it may be tricky so im hoping all you genious's can help me out here... thankyou heaps...

here is the code i got for saving the workbook but it doesnt work:



my solutions so far (that doesnt work)

Private Sub CommandButton1_Click()
Dim wbpath$, oprtr$, mnth$, yr$
Dim Sht As Worksheet
' name new workbook according to file path to which original was saved and add Operator, Month, and Year to name
Application.ScreenUpdating = False
If Range("f24") = "-" Then
MsgBox "Operator name must be entered"
Exit Sub
End If
If Range("f26") = "-" Then
MsgBox "Month must be entered"
Exit Sub
End If
If Range("f27") = "-" Then
MsgBox "Year must be entered"
Exit Sub
End If
With Sheets("cover sheet")
oprtr$ = .Range("f24")
mnth$ = .Range("f26")
yr$ = .Range("f27")
End With
Sheets("Cover Sheet").Shapes("CommandButton1").Delete
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Cover Sheet" Then Sht.Visible = True
Next
Application.Run "rename_sheets"
Application.Run "hidefirstlast"
ThisWorkbook.SaveAs Application.ActiveWorkbook.Path & "\Cash Reconciliation " & oprtr$ & " " & mnth$ & " " & yr$
Application.ScreenUpdating = True

If Range("f26") = "April" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "June" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "September" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "November" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "February" Then
Sheet36.Visible = False
Sheet35.Visible = False
Sheet1.Range("39:40").EntireRow.Hidden = True
End If

End Sub



Option Explicit

Function FileExists(Path As String) As Boolean

Dim F As File
Dim FSO As New FileSystemObject

On Error Resume Next
Set F = FSO.GetFile(Path)
On Error GoTo 0

FileExists = Not F Is Nothing

Set F = Nothing
Set FSO = Nothing

End Function

mdmackillop
01-31-2007, 01:39 AM
No time to test, but you need something like the code in asterisks.
Also this will fail
Sheet36.Visible = False
You need
Sheets("Sheet36").Visible=False
and similar changes.

Option Explicit

Private Sub CommandButton1_Click()
Dim wbpath$, oprtr$, mnth$, yr$
Dim Sht As Worksheet, MyFile As String
' name new workbook according to file path to which original was saved and add Operator, Month, and Year to name
Application.ScreenUpdating = False
If Range("f24") = "-" Then
MsgBox "Operator name must be entered"
Exit Sub
End If
If Range("f26") = "-" Then
MsgBox "Month must be entered"
Exit Sub
End If
If Range("f27") = "-" Then
MsgBox "Year must be entered"
Exit Sub
End If
With Sheets("cover sheet")
oprtr$ = .Range("f24")
mnth$ = .Range("f26")
yr$ = .Range("f27")
End With
Sheets("Cover Sheet").Shapes("CommandButton1").Delete
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Cover Sheet" Then Sht.Visible = True
Next
Application.Run "rename_sheets"
Application.Run "hidefirstlast"
'********************************************
MyFile = Application.ActiveWorkbook.Path & "\Cash Reconciliation " & oprtr$ & " " & mnth$ & " " & yr$
If FileExists(MyFile) Then
MsgBox "File Exists"
'Do something else
Exit Sub
Else
ThisWorkbook.SaveAs MyFile
End If
'****************************************
Application.ScreenUpdating = True

If Range("f26") = "April" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "June" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "September" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "November" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "February" Then
Sheet36.Visible = False
Sheet35.Visible = False
Sheet1.Range("39:40").EntireRow.Hidden = True
End If

End Sub




Function FileExists(Path As String) As Boolean

Dim F As File
Dim FSO As New FileSystemObject

On Error Resume Next
Set F = FSO.GetFile(Path)
On Error GoTo 0

FileExists = Not F Is Nothing

Set F = Nothing
Set FSO = Nothing

End Function

Bob Phillips
01-31-2007, 04:03 AM
You don't need FSO,



Function FileExists(Path As String) As Boolean
Dim sfile As String
sfile = Dir(Path, vbNormal)
FileExists = sfile <> ""
End Function

johnske
01-31-2007, 04:27 AM
You don't need sFile either...

Function FileExists(Path As String) As Boolean
FileExists = Dir(Path, vbNormal) <> ""
End Function

mdmackillop
01-31-2007, 06:19 AM
So why bother with the function?
If Dir(Path, vbNormal) <> "" Then DoEvents

Bob Phillips
01-31-2007, 06:32 AM
We didn't introduce it, we just showed that FSO was overkill.

johnske
01-31-2007, 06:36 AM
So why bother with the function?
If Dir(Path, vbNormal) <> "" Then DoEventsExactly :thumb

cbs81
02-01-2007, 09:54 PM
Hi everyone... im still having problems... I would like excel to not even ask the user if they would like to overwrite the file... the following code after the user presses the button, still outputs the option for the user if they would like to overwrite the previous file... i want to tell the user the file already exists and make them select some other options from the drop down box.... any ideas of how i can avoid the risk of a user of my application to overwrite the previous file created by accidently selecting yes on the above option..... i have tried all the previous above forum submission... any help would be soooper appreciated...




Private Sub CommandButton1_Click()
Dim wbpath$, oprtr$, mnth$, yr$
Dim Sht As Worksheet
' name new workbook according to file path to which original was saved and add Operator, Month, and Year to name
Application.ScreenUpdating = False
If Range("f24") = "-" Then
MsgBox "Operator name must be entered"
Exit Sub
End If
If Range("f26") = "-" Then
MsgBox "Month must be entered"
Exit Sub
End If
If Range("f27") = "-" Then
MsgBox "Year must be entered"
Exit Sub
End If
With Sheets("cover sheet")
oprtr$ = .Range("f24")
mnth$ = .Range("f26")
yr$ = .Range("f27")
End With


With Worksheets("Cover Sheet")
.Unprotect Password:="cbs"
Sheets("Cover Sheet").Shapes("CommandButton1").Delete
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Cover Sheet" Then Sht.Visible = True
Next
Application.Run "rename_sheets"
Application.Run "hidefirstlast"

'***************************

If Not FileExists(Application.ActiveWorkbook.Path & "\Cash Reconciliation " & oprtr$ & " " & mnth$ & " " & yr$) Then
ThisWorkbook.SaveAs Application.ActiveWorkbook.Path & "\Cash Reconciliation " & oprtr$ & " " & mnth$ & " " & yr$
Application.ScreenUpdating = True
Else
MsgBox "File exists"
End If

'***************************

If Range("f26") = "April" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "June" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "September" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "November" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "February" Then
Sheet36.Visible = False
Sheet35.Visible = False
Sheet1.Range("39:40").EntireRow.Hidden = True
End If
End With
End Sub



Function FileExists(Path As String) As Boolean
Dim sfile As String
sfile = Dir(Path, vbNormal)
FileExists = sfile <> ""
End Function

Bob Phillips
02-02-2007, 04:07 AM
Private Sub CommandButton1_Click()
Dim wbpath$, oprtr$, mnth$, yr$
Dim Sht As Worksheet
Dim sPath As String
' name new workbook according to file path to which original was saved and add Operator, Month, and Year to name
Application.ScreenUpdating = False
If Range("f24") = "-" Then
MsgBox "Operator name must be entered"
Exit Sub
End If
If Range("f26") = "-" Then
MsgBox "Month must be entered"
Exit Sub
End If
If Range("f27") = "-" Then
MsgBox "Year must be entered"
Exit Sub
End If
With Sheets("cover sheet")
oprtr$ = .Range("f24")
mnth$ = .Range("f26")
yr$ = .Range("f27")
End With


With Worksheets("Cover Sheet")
.Unprotect Password:="cbs"
Sheets("Cover Sheet").Shapes("CommandButton1").Delete
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Cover Sheet" Then Sht.Visible = True
Next
Application.Run "rename_sheets"
Application.Run "hidefirstlast"

'***************************

sPath = Application.ActiveWorkbook.Path & "\Cash Reconciliation " & _
oprtr$ & " " & mnth$ & " " & yr$
If Not FileExists(sPath) Then
Application.DisplayAlerts = False
ThisWorkbook.SaveAs sPath
Application.ScreenUpdating = True
Else
MsgBox "File exists"
End If

'***************************

If Range("f26") = "April" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "June" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "September" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "November" Then
Sheet36.Visible = False
Sheet1.Range("40:40").EntireRow.Hidden = True
End If
If Range("f26") = "February" Then
Sheet36.Visible = False
Sheet35.Visible = False
Sheet1.Range("39:40").EntireRow.Hidden = True
End If
End With
End Sub

Function FileExists(Path As String) As Boolean
Dim sfile As String
sfile = Dir(Path, vbNormal)
FileExists = sfile <> ""
End Function

cbs81
02-04-2007, 05:41 PM
Hi there, We are getting closer to the solution but still have a small problem.

Using the exact code above when I select the same parameters from the drop down box which matches an existing file. Excel then outputs the message:

Runtime Error '1004'

operation failed. H:\Bus operator cash reconciliation\cash Reconciliation buslink march 2007.xls' is write reserved.

The buttons 'end' and help only appear.

if you click on end, the rest of the macro will occur.. this changes the template original version.. now if you close excel, it will ask you do you want to overwrite original template file.. if you click on no then the template will remain the same..

Now at least the file that exists with data is not overwritten which is a good thing... is there anyway we can solve this problem where we can get a msg box to appear if the file is the same and force the user to change the parameters again rather than this error msg...

Thankyou for providing the closest code to the solution I require... I hope you can come up with some magic and help me with this error msg code or explain how and why this occurs if there is no workaround..

thankyou

Bob Phillips
02-05-2007, 02:27 AM
AM I reading this correctly? Previously you wanted it to save without any warnbings, now you want the warnings?

cbs81
02-05-2007, 04:22 PM
Basically, I do not want Excel to save the file at all if the file already exists on the system.. i would like a message to come up saying:

This file already exists.. please change your parameters

I would like to msg box to appear with only an OK option for the user to select

if this msg box appears, and the file is the same, do not finish the rest of the code..

let me know what you think

cheers