Advice to edit code so deleting by mistke doesnt happen

[ipbr21054]

Morning as per title.
I use the following code shown below.
The code is used when i make an update to a file then the code replaces all my files with the new update for future use.

I have a folder called CURRENT SHEETS of which has the following folders inside followed by worksheets ACCOUNTS
06 JUNE 07 JULY 08 AUGUST etc etc.

My reason for this edit is that ive just deleted / updated this months file by mistake & now all my records are gone.
So i cant afford this to happen again hence my reason for an edit to the code in use.

Hopefully it would work like so if you could advise please.

The code should compare the current month & then look inside that months file worhseet for a value before deleting / updating.
When i run the code shown below i need the code to check in the current months file if there is a value & if so just update all the other files & to leave the current file alone & not delete / update it, Make sense ?


My folders 06 JUNE 07 JULY 08 AUGUST are in a main folder called CURRENT SHEETS & inside each of thos folders is a worksheet called AACOUNTS
The current month is MAY so the folder in question is called 05 MAY
The worksheet inside each folder will always be called ACCOUNTS.
On that Sheet we need to look at sheet called INCOME (1)
This is where we now decide if we delete / update this file,if in use then there will be a value in cell B1
So if there is a value in cell B1 "this sheet will have all my records" so leave this worksheet alone & then just delete/ update all the others etc 06 JUNE 07 JULY 08 AUGUST
Hopefully this will not delete / update the current months file.

The code will then be the same when we move on through the year.
Example AUGUST
So folder will be 08 AUGUST
Worksheet called ACCOUNTS
Sheet is called INCOME (1)
Is there a value in cell B1 yes or no depending on answer then either delete / update or leave this one alone

Private Sub NewFileToFolders_Click()
    Dim FileName As String
    Dim SaveName As String
    Dim FromPath As String
    Dim ToPath As String
    Dim fldrArr As Variant
    Dim x      As Long
    Dim FSO    As Object
    FileName = "ACCOUNTS TEMPLATE.xlsm"
    SaveName = "ACCOUNTS.xlsm"
    FromPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\"
    ToPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\"
    fldrArr = Array("04 APRIL", "05 MAY", "06 JUNE", "07 JULY", "08 AUGUST", "09 SEPTEMBER", "10 OCTOBER", "11 NOVEMBER", "12 DECEMBER", "13 JANUARY", "14 FEBRUARY", "15 MARCH", "16 APRIL")
    On Error Resume Next
    For x = LBound(fldrArr) To UBound(fldrArr)
        Set FSO = CreateObject("Scripting.FileSystemObject")
        FSO.CopyFile Source:=FromPath & FileName, Destination:=ToPath & fldrArr(x) & "\" & SaveName
    Next x
    MsgBox "ALL FILES NOW TRANSFERED TO FOLDERS", vbInformation, "CONFIRMATION MESSAGE"
    Set FSO = Nothing

End Sub

 

[rlv01]

Instead of adding all that complexity, what about just asking for permission to overwrite and existing file and/or creating a backup version before it is overwritten?
(not tested):

Private Sub NewFileToFolders_Click()
    Dim FileName As String
    Dim SaveName As String, PrevName As String
    Dim FromPath As String
    Dim ToPath As String
    Dim SrcFile As String, DestFile As String, PrevFile As String
    Dim fldrArr As Variant
    Dim x As Long
    Dim FSO As Object
    Dim CopyCnt As Long

    FileName = "ACCOUNTS TEMPLATE.xlsm"
    SaveName = "ACCOUNTS.xlsm"
    PrevName = "ACCOUNTS_PREV.xlsm"
    FromPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\"
    ToPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\"

    fldrArr = Array("04 APRIL", "05 MAY", "06 JUNE", "07 JULY", "08 AUGUST", "09 SEPTEMBER", "10 OCTOBER", "11 NOVEMBER", "12 DECEMBER", "13 JANUARY", "14 FEBRUARY", "15 MARCH", "16 APRIL")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    SrcFile = FromPath & FileName
    If FSO.FileExists(SrcFile) Then
        On Error Resume Next
        For x = LBound(fldrArr) To UBound(fldrArr)
            DestFile = ToPath & fldrArr(x) & "\" & SaveName
            PrevFile = ToPath & fldrArr(x) & "\" & PrevName

            If FSO.FileExists(DestFile) Then
                Select Case MsgBox("Workbook" & vbCrLf & vbCrLf & DestFile & vbCrLf & vbCrLf _
                & "already exists and will be overwritten (a backup will be created)." & vbCrLf & vbCrLf & "Proceed?", vbYesNoCancel Or vbExclamation, Application.Name)
                Case vbYes
                    FSO.CopyFile Source:=DestFile, Destination:=PrevFile
                    FSO.CopyFile Source:=SrcFile, Destination:=DestFile
                    CopyCnt = CopyCnt + 1
                Case vbCancel
                    MsgBox "User Abort"
                    Exit Sub
                End Select
            Else
                FSO.CopyFile Source:=SrcFile, Destination:=DestFile
                CopyCnt = CopyCnt + 1
            End If
        Next x

        MsgBox CopyCnt & " FILES NOW TRANSFERED TO FOLDERS", vbInformation, "CONFIRMATION MESSAGE"
    End If
    Set FSO = Nothing
End Sub

 

[ipbr21054]

The above works well but it would need a slight change.

Its MAY so the first file in use & the only file with records in use would be MAY 05
All other files like JUNE 06 JULY 07 etc etc are all empty so can be just overwritten

The Back up file created in this case will be MAY 05 & is the other file that needs the user to to agree to being overwritten.
All the others can be overwritten no problem.

Currently i am seeing a message to advise about overwriting the file for every file so i am clicking YES 13 times.

This is why i thought to look at current month & only say yes to current file then create Back up, the others can be overwritten without the need to say yes to the message prompt.

Works very well otherwise
Thanks

 

[rlv01]

Something like this, then.

Function CurrentMonth(ByVal fldr As String) As Boolean
    Dim CurMonth As String
    CurMonth = UCase(Format(Date, "mmm"))
    fldr = Left(Trim(Split(UCase(fldr), " ")(1)), 3)
    CurrentMonth = fldr = CurMonth
End Function

Private Sub NewFileToFolders_Click()
    Dim FileName As String
    Dim SaveName As String, PrevName As String
    Dim FromPath As String
    Dim ToPath As String
    Dim SrcFile As String, DestFile As String, PrevFile As String
    Dim fldrArr As Variant
    Dim x As Long
    Dim FSO As Object
    Dim CopyCnt As Long

    FileName = "ACCOUNTS TEMPLATE.xlsm"
    SaveName = "ACCOUNTS.xlsm"
    PrevName = "ACCOUNTS_PREV.xlsm"
    FromPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\"
    ToPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\"

    fldrArr = Array("04 APRIL", "05 MAY", "06 JUNE", "07 JULY", "08 AUGUST", "09 SEPTEMBER", "10 OCTOBER", "11 NOVEMBER", "12 DECEMBER", "13 JANUARY", "14 FEBRUARY", "15 MARCH", "16 APRIL")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    SrcFile = FromPath & FileName
    If FSO.FileExists(SrcFile) Then
        On Error Resume Next
        For x = LBound(fldrArr) To UBound(fldrArr)
            DestFile = ToPath & fldrArr(x) & "\" & SaveName
            PrevFile = ToPath & fldrArr(x) & "\" & PrevName
            If FSO.FileExists(DestFile) And CurrentMonth(fldrArr(x)) Then
                Select Case MsgBox("Workbook" & vbCrLf & vbCrLf & DestFile & vbCrLf & vbCrLf _
                                 & "already exists and will be overwritten (a backup will be created)." & vbCrLf & vbCrLf & "Proceed?", vbYesNoCancel Or vbExclamation, Application.Name)
                Case vbYes
                    FSO.CopyFile Source:=DestFile, Destination:=PrevFile
                    FSO.CopyFile Source:=SrcFile, Destination:=DestFile
                    CopyCnt = CopyCnt + 1
                Case vbCancel
                    MsgBox "User Abort"
                    Exit Sub
                End Select
            Else
                FSO.CopyFile Source:=SrcFile, Destination:=DestFile
                CopyCnt = CopyCnt + 1
            End If
        Next x

        MsgBox CopyCnt & " FILES NOW TRANSFERED TO FOLDERS", vbInformation, "CONFIRMATION MESSAGE"
    End If
    Set FSO = Nothing
End Sub

 

[ipbr21054]

Hi,
Where does the function code to please ?

 

[ipbr21054]

Now placed in a module & works great

Many thanks for your time

 

[ipbr21054]

Evening,
I have just looked at this again & i am sure this didnt happen with the previous code.
Looking in all the folders i see the original file called ACCOUNTS & also Back up file for every month & this isnt needed.

The only folder which is possible for overwriting by mistake is the current month.

So when i run the command code,
For current month make a back up & have a new file called ACCOUNTS
For ALL other folders just overwrite the ACCOUNT file,no need to make back up for them as they are not the current month.

Thanks

 

[ipbr21054]

Forget the last post for the time being as it didnt do it this time.

I will reply later