WorkbookSave_ANmar

Saves a workbook handling several scenarios and decide what to do based on each.
If workbook already found, function either delete already existing file, rename old file, or rename new file, all based through call "SaveOverMode"
FullFile: Full path and filename
SaveOverMode: What to do if already found
                0=Cancel save if already found
                1=Save over file
                2=Rename this file to same name + counter
                3=Rename already existing file with counter
CloseifOpen: Close workbook if already open after save

CodeFunctionName
What is this?

Public

Tested

Original Work
Function WorkbookSave_ANmar(FullFile, Optional Wb = "This", Optional SaveOverMode = 0, Optional CloseifOpen = 0)
    ' Saves workbook and returns full file name if successfully saved (or new name), bull if no save happen
    ' FullFile: Full path and filename
    ' SaveOverMode: What to do if already found
    '                0=Cancel save if already found
    '                1=Save over file
    '                2=Rename this file to same name + counter
    '                3=Rename already existing file with counter
    ' CloseifOpen: Close workbook if already open after save
    '
    ' Needs: FindFile(), GetPapa(), IsThere1(), GetExtension(), GetFileName_noextension()
    '
    Rett = ""
    On Error GoTo ByeBye
    If Wb = "This" Then Wb = ThisWorkbook.Name
    If Not FindFile(Wb) Then GoTo ByeBye
    If IsThere1(FullFile, True, True) Then
        If SaveOverMode = 0 Then
            GoTo ByeBye
        ElseIf SaveOverMode = 1 Then ' delete file found
            Kill FullFile ' tries to delete file
            DoEvents
        ElseIf SaveOverMode = 2 Then ' rename this file to new name
            X1 = 1
RenameMyWB:
            NewName = GetPapa(FullFile) & "\" & GetFilename_noExtension(FullFile) & X1 & "." & GetExtension(FullFile)
            If IsThere1(NewName, True, True) Then
                X1 = X1 + 1
                GoTo RenameMyWB
            End If
            FullFile = NewName
        ElseIf SaveOverMode = 3 Then ' rename file found to new name
            X1 = 1
RenameFoundWB:
            NewName = GetPapa(FullFile) & "\" & GetFilename_noExtension(FullFile) & X1 & "." & GetExtension(FullFile)
            If IsThere1(NewName, True, True) Then
                X1 = X1 + 1
                GoTo RenameFoundWB
            End If
            Name FullFile As NewName
            DoEvents
        Else
            GoTo ByeBye
        End If
    End If
    DoEvents
    Workbooks(Wb).SaveAs FullFile
    DoEvents
    Rett = FullFile
    If CloseifOpen = 1 Then Workbooks(Wb).Close False
ByeBye:
    WorkbookSave_ANmar = Rett
End Function

FullFile, Optional Wb = "This", Optional SaveOverMode = 0, Optional CloseifOpen = 0

Views 112

Downloads 67

CodeID
DB ID