Consulting

Results 1 to 14 of 14

Thread: VB Code for saving a workbook with duplication prevention

  1. #1
    VBAX Regular
    Joined
    Jan 2007
    Posts
    42
    Location

    VB Code for saving a workbook with duplication prevention

    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:






    [vba]
    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

    [/vba]

  2. #2
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    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)

    [vba]
    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
    [/vba]

  3. #3
    VBAX Regular
    Joined
    Jan 2007
    Posts
    42
    Location
    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

  4. #4
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    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.

    [VBA]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
    [/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  5. #5
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    You don't need FSO,

    [vba]

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

  6. #6
    Administrator
    Chat VP VBAX Guru johnske's Avatar
    Joined
    Jul 2004
    Location
    Townsville, Australia
    Posts
    2,872
    Location
    You don't need sFile either...
    [VBA]
    Function FileExists(Path As String) As Boolean
    FileExists = Dir(Path, vbNormal) <> ""
    End Function
    [/VBA]
    You know you're really in trouble when the light at the end of the tunnel turns out to be the headlight of a train hurtling towards you

    The major part of getting the right answer lies in asking the right question...


    Made your code more readable, use VBA tags (this automatically inserts [vba] at the start of your code, and [/vba ] at the end of your code) | Help those helping you by marking your thread solved when it is.

  7. #7
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    So why bother with the function?
    [VBA]If Dir(Path, vbNormal) <> "" Then DoEvents[/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  8. #8
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    We didn't introduce it, we just showed that FSO was overkill.

  9. #9
    Administrator
    Chat VP VBAX Guru johnske's Avatar
    Joined
    Jul 2004
    Location
    Townsville, Australia
    Posts
    2,872
    Location
    Quote Originally Posted by mdmackillop
    So why bother with the function?
    [vba]If Dir(Path, vbNormal) <> "" Then DoEvents[/vba]
    Exactly
    You know you're really in trouble when the light at the end of the tunnel turns out to be the headlight of a train hurtling towards you

    The major part of getting the right answer lies in asking the right question...


    Made your code more readable, use VBA tags (this automatically inserts [vba] at the start of your code, and [/vba ] at the end of your code) | Help those helping you by marking your thread solved when it is.

  10. #10
    VBAX Regular
    Joined
    Jan 2007
    Posts
    42
    Location
    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

  11. #11
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    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
    [/vba]

  12. #12
    VBAX Regular
    Joined
    Jan 2007
    Posts
    42
    Location
    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

  13. #13
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    AM I reading this correctly? Previously you wanted it to save without any warnbings, now you want the warnings?

  14. #14
    VBAX Regular
    Joined
    Jan 2007
    Posts
    42
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •