Kill Command should work according to everything I have read, but it doesn't

TheEnginerd

New Member
Joined
Jul 22, 2024
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hey everyone,

I have a macro that checks to see if the excel file open is the latest version for my technicians. I am able to successfully check, download have it rename everything. But once I get to the Kill it gives me the good ol' You don't have permission to delete that error. I have posted the necessary code and constants below for reference. Any help would be amazing! Thanks in advance.

VBA Code:
Option Explicit


Private Const TemplateName As String = "Automated RMA Traveler Template.xlsm"
Private Const TextFileName As String = "FileUpdateStatus.txt"
Private Const RemoteTextRevFileFullName As String = "\\NetworkDrive\Automated RMA Traveler Files\Traveler\FileUpdateStatusProto.txt"
Private Const tempFolder As String = "\Temp\"
Private Const DeleteFileName As String = "Automated RMA Traveler Template_temp_2.xlsm"


Sub CheckForUpdates()
    Dim FileNumber As Integer
    Dim RemoteRevNum As Double
    Dim RemoteXlsmFileFullName As String
    Dim LocalXlsmFileFullName As String
    Dim TempLocalXlsmFileFullName As String
    Dim LocalRevFileFullName As String
    Dim FullName As String
    Dim rootFolder As String
    Dim deleteTempPath As String

    'Create the root folder path string
    rootFolder = "C:\Users\" _
    & UserNameFunc(firstDotlast) & _
    "\Desktop\Traveler\"
    'UserNameFunc is my function that pulls the users name in my desired format

    LocalRevFileFullName = rootFolder & TextFileName

    FileCopy RemoteTextRevFileFullName, LocalRevFileFullName

    If Len(Dir(LocalRevFileFullName)) = 20 Then

        FileNumber = FreeFile
        On Error Resume Next
        Open LocalRevFileFullName For Input As #FileNumber
        Input #FileNumber, RemoteRevNum
        Input #FileNumber, RemoteXlsmFileFullName
        Close #FileNumber
        Kill LocalRevFileFullName
        On Error GoTo 0
        
        LocalXlsmFileFullName = rootFolder & Dir(RemoteXlsmFileFullName)
        'If IsDate(InputCheckForValidDate) Then
        '   RemoteXlsmFileRev = CDate(InputCheckForValidDate)
        'End If
        
        'if the name does not yet exist, an error will not be raised
        'however, the statement will evaluate to True and
        'attempt to download the update whether it is actually
        'more recent or not
        If RemoteRevNum > CDbl([Update_Rev]) Then
            If MsgBox("An update is available. Click 'OK' to overwrite" & _
                " the current local version with the newest version.", vbOKCancel) = vbOK Then

                LocalXlsmFileFullName = Replace(LocalXlsmFileFullName, ".xlsm", "_temp.xlsm")
                'download updated file
                FileCopy RemoteXlsmFileFullName, LocalXlsmFileFullName
                If Len(Dir(LocalXlsmFileFullName)) = 49 Then    'Proto
                'If Len(Dir(LocalXlsmFileFullName)) = 41 Then   'Not Proto
                    On Error Resume Next
                    Kill Replace(LocalXlsmFileFullName, "_temp.xlsm", "_temp_2.xlsm")
                    On Error GoTo 0

                    'must temporarily change the name of the activeworkbook and
                    'change the file access to readonly
                    ThisWorkbook.SaveAs Replace(LocalXlsmFileFullName, "_temp.xlsm", "_temp_2.xlsm")
                    If ThisWorkbook.ReadOnly = False Then
                        ThisWorkbook.ChangeFileAccess xlReadOnly
                    End If

                    'create a name at the application level so that Open code is not run
                    'flag here. checked in workbook open
                    Application.ExecuteExcel4Macro "SET.NAME(""RunCode"",""NO"")"
                    Kill Replace(LocalXlsmFileFullName, "_temp.xlsm", ".xlsm")

                    'Save the 
                    Name LocalXlsmFileFullName As Replace(LocalXlsmFileFullName, "_temp.xlsm", ".xlsm")
                    
                    Kill Replace(LocalXlsmFileFullName, "_temp.xlsm", "_temp_2.xlsm")    'This is where it always fails and says I don't have permission.
                    Application.StatusBar = "Update Successful. You have the most current version..."
                    ThisWorkbook.Close False
                Else
                    Application.StatusBar = "Update available. Failed to download updated version..."
                End If
            Else
                Application.StatusBar = "Update available. User cancelled update..."
            End If
        Else
            'deleteTempPath = rootFolder & DeleteFileName
            Application.StatusBar = "You have the most current version..."
            'If Len(Dir(deleteTempPath)) <> 0 Then Kill deleteTempPath
            '^^^This If statement actually works to delete the old file,
            'but I want it to delete the old one right away
        End If
    Else
        Application.StatusBar = "Failed to download update notification file..."
    End If
End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
VBA Code:
                    'must temporarily change the name of the activeworkbook and
                    'change the file access to readonly
                    ThisWorkbook.SaveAs Replace(LocalXlsmFileFullName, "_temp.xlsm", "_temp_2.xlsm")
...
                    Kill Replace(LocalXlsmFileFullName, "_temp.xlsm", "_temp_2.xlsm")    'This is where it always fails and says I don't have permission.
I think this is where the problems lies.
The first line (SaveAs) saves the workbook as ...._temp_2.xlsm, but the problem is that at the same time it opens it - so two things:
  1. I am not sure which is ThisWorkbook at this moment
  2. you don't have the permissions to delete a locked file.

Normally I would do all this (not sure but I think it's generally done this way) from another small file, dedicated to this purpose only.
 
Upvote 0
VBA Code:
                    'must temporarily change the name of the activeworkbook and
                    'change the file access to readonly
                    ThisWorkbook.SaveAs Replace(LocalXlsmFileFullName, "_temp.xlsm", "_temp_2.xlsm")
...
                    Kill Replace(LocalXlsmFileFullName, "_temp.xlsm", "_temp_2.xlsm")    'This is where it always fails and says I don't have permission.
I think this is where the problems lies.
The first line (SaveAs) saves the workbook as ...._temp_2.xlsm, but the problem is that at the same time it opens it - so two things:
  1. I am not sure which is ThisWorkbook at this moment
  2. you don't have the permissions to delete a locked file.

Normally I would do all this (not sure but I think it's generally done this way) from another small file, dedicated to this purpose only.

First off thanks for the quick reply.

But to answer the first thing above. "ThisWorkbook" is the original document running the program to check if it is the most recent version of the file. I got this code from an old forum and it does almost exactly what I want it to do.

So, if I want this program that to run from a separate small file like you state above, how would I go about doing that automatically without running into all of the "Enable Macro" warnings that I know my technicians will ignore.
 
Upvote 0
VBA Code:
                    'must temporarily change the name of the activeworkbook and
                    'change the file access to readonly
                    ThisWorkbook.SaveAs Replace(LocalXlsmFileFullName, "_temp.xlsm", "_temp_2.xlsm")
...
                    Kill Replace(LocalXlsmFileFullName, "_temp.xlsm", "_temp_2.xlsm")    'This is where it always fails and says I don't have permission.
I think this is where the problems lies.
The first line (SaveAs) saves the workbook as ...._temp_2.xlsm, but the problem is that at the same time it opens it - so two things:
  1. I am not sure which is ThisWorkbook at this moment
  2. you don't have the permissions to delete a locked file.

Normally I would do all this (not sure but I think it's generally done this way) from another small file, dedicated to this purpose only.
So I took your advice on using a separate file for it. I posted my code below.

The Text file only contains 3 lines - Revision number, Template file path, and RevChange file path
1.19
\\MyNetworkDrive\Traveler\Automated RMA Traveler Template.xlsm
\\MyNetworkDrive\Traveler\RevChange.xlsm

VBA Code:
Option Explicit

Private Const TemplateName As String = "Automated RMA Traveler Template.xlsm"    'The name of the template - some of these are redundant but I don't mind
Private Const TextFileName As String = "FileUpdateStatus.txt"   'this is the name of that text file
Private Const RemoteTextRevFileFullName As String = "\\MyNetworkDrive\Traveler\FileUpdateStatus.txt"   'This is the location for the text file
Private Const RevMacro As String = "StartTimer"   'The macro that I call sets a timer that when elapsed, runs another macro

Sub CheckForUpdates()
    Dim FileNumber As Integer
    Dim RemoteRevNum As Double
    Dim RemoteXlsmFileFullName As String
    Dim LocalXlsmFileFullName As String
    Dim LocalRevFileFullName As String
    Dim rootFolder As String
    Dim RevChangePath As String
    Dim RevChangeFile As String

    'Create the root folder path string
    rootFolder = "C:\Users\" _
    & UserNameFunc(firstDotlast) & _
    "\Desktop\Traveler\"

    LocalXlsmFileFullName = rootFolder & TemplateName

    LocalRevFileFullName = rootFolder & TextFileName

    FileCopy RemoteTextRevFileFullName, LocalRevFileFullName   'Copy .txt Text file

    If Len(Dir(LocalRevFileFullName)) = 20 Then
        
        'Pull information from the Text File that you saved to the server
        FileNumber = FreeFile
        On Error Resume Next
        Open LocalRevFileFullName For Input As #FileNumber
        Input #FileNumber, RemoteRevNum                'Revision Number
        Input #FileNumber, RemoteXlsmFileFullName    'Template path
        Input #FileNumber, RevChangePath            'RevChange File path
        Close #FileNumber
        Kill LocalRevFileFullName
        On Error GoTo 0
        
        'Get RevChange File Name only
        RevChangeFile = Dir(RevChangePath)

        'if the name does not yet exist, an error will not be raised
        'however, the statement will evaluate to True and
        'attempt to download the update rather it is actually
        'more recent or not
        If RemoteRevNum > CDbl([Update_Rev]) Then
            If MsgBox("An update is available. Click 'OK' to overwrite" & _
                " the current local version with the newest version.", vbOKCancel) = vbOK Then
                
                'Call sub that opens and starts the macro that will download
                'and replace the older template
                OpenAndRunRevChange rootFolder, RevChangeFile, RevChangePath
            Else
                Application.StatusBar = "Update available. User cancelled update..."
            End If
        Else
            Application.StatusBar = "You have the most current version..."
        End If
    Else
        Application.StatusBar = "Failed to download update notification file..."
    End If
End Sub

Sub OpenAndRunRevChange(ByVal root As String, _
ByVal RevFile As String, ByVal RevFilePath As String)
    Dim wb As Workbook
    Dim Macro As String
    
    'Generate the string for the app.run Function
    Macro = "'" & RevFile & "'!" & RevMacro    
    On Error GoTo OpenFile
    'Check to see if file is already open or not
    Set wb = Workbooks("RevFile")
    
runMacro:    'file opened now so macro will run
    Application.Run Macro
    Exit Sub
OpenFile:    'file wasn't open
    'Open the file because it was not open
    Workbooks.Open (RevFilePath)
    ActiveWindow.Visible = False
    Resume runMacro

End Sub


And the OpenAndRunRevChange bit of code opens another Excel file and sets a timer to when another sub should run, and closes the original template.
The code that triggers after (what I put) a half a second (a relatively long time in the realm of computers) then grabs the paths from the same text file, downloads it as filename + "_temp.xlsm", deletes the old one if it was successful at downloading, deletes the old one, renames the up-to-date one by removing "_temp", opens it, and then closes the rev change file. As seen below.

VBA Code:
Option Explicit

Public Enum NameFormat
    FirstLast = 1
    firstDotlast = 2
End Enum

Public RunWhen As Double
Public Const runInterval = 0.5 'half second
Public Const runRevChangeMacro = "RevChange"


Public Const TemplateName As String = "Automated RMA Traveler Template - proto.xlsm"
Private Const RevLocation As String = "\RevChange\RevChange.xlsm"
Private Const RevFile As String = "RevChange.xlsm"

'New file constants
Private Const TextFileName As String = "FileUpdateStatus.txt"
Private Const RemoteTextRevFileFullName As String = "\\MyNetworkDrive\Traveler\FileUpdateStatus.txt"
Private Const tempFolder As String = "\Temp\"
Private Const DeleteFileName As String = "Automated RMA Traveler Template_temp_2.xlsm"


Sub StartTimer()
    RunWhen = Now + TimeSerial(0, 0, runInterval)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=runRevChangeMacro, _
        Schedule:=True
    'Debug.Print "Timer Started!"
    'Close Original Template
    Workbooks(TemplateName).Close False
End Sub

'This sub is based off the original program that I posted. It does all of the copying and deleting and renaming of files
Sub RevChange()
    Dim FileNumber As Integer
    Dim RemoteRevNum As Double
    Dim RemoteXlsmFileFullName As String
    Dim LocalXlsmFileFullName As String
    Dim LocalRevFileFullName As String
    Dim RevFilePath As String
    Dim rootFolder As String


    'Create the root folder path string
    rootFolder = "C:\Users\" _
    & UserNameFunc(firstDotlast) & _
    "\OneDrive - S & C Electric Company\Desktop\Traveler\"
    
    'Name local template path
    LocalXlsmFileFullName = rootFolder & TemplateName
    'name the local text file path
    LocalRevFileFullName = rootFolder & TextFileName
    
    FileCopy RemoteTextRevFileFullName, LocalRevFileFullName
    
    'Pull information from the text file again
    'I know it's redundant but I know it works
    FileNumber = FreeFile
    On Error Resume Next
    Open LocalRevFileFullName For Input As #FileNumber
    Input #FileNumber, RemoteRevNum
    Input #FileNumber, RemoteXlsmFileFullName
    Close #FileNumber
    Kill LocalRevFileFullName
    On Error GoTo 0

    LocalXlsmFileFullName = Replace(LocalXlsmFileFullName, ".xlsm", "_temp.xlsm")
    
    'Attempt to delete any _temp files that may be hanging around if not NEXT!
    On Error Resume Next
    Kill LocalXlsmFileFullName
    On Error GoTo 0
    
    'download updated file and add "_temp" to the file name
    FileCopy RemoteXlsmFileFullName, LocalXlsmFileFullName
    If Len(Dir(LocalXlsmFileFullName)) = 41 Then
        'Delete the out of date local file
        Kill Replace(LocalXlsmFileFullName, "_temp.xlsm", ".xlsm")
        
        'Name the downloaded file as the new Template File
        Name LocalXlsmFileFullName As Replace(LocalXlsmFileFullName, "_temp.xlsm", ".xlsm")   'rename new template by removing the "_temp" part
        Workbooks.Open (Replace(LocalXlsmFileFullName, "_temp.xlsm", ".xlsm"))   'open the new updated template
        Application.StatusBar = "Update Successful. You have the most current version..."
        'Debug.Print "It worked!!!"   'A little message to myself when writing the code
        ThisWorkbook.Close False    'Close down the RevChange program and don't save.

    Else
        Application.StatusBar = "Update available. Failed to download updated version..."
    End If
End Sub

Sub visible()   'used to make the file visible again incase the program froze
    Workbooks(RevFile).Activate
    ActiveWindow.visible = True
End Sub

'This program outputs the user's name in two formats "First Last" and "first.last"
'the optional passed in argument are enumerated above
Function UserNameFunc(Optional ByVal form As NameFormat = FirstLast) As String
    Dim fName As String, lName As String           'Create User Name Variables
    Dim FullName As Variant                      'Create variant named FullName which can be an array
    
    FullName = Application.UserName    'User's name originally looks like "Last, First"
    
    Select Case form
        Case FirstLast
            FullName = Split(FullName, ",")                  'Split at comma
            lName = Trim(FullName(0))                        'Trim leading and trailing spaces around the last name
            FullName = Split(Trim(FullName(1)))                   'Get to the first name
            fName = Trim(FullName(0))                        'Trim leading and trailing spaces around the first name
            UserNameFunc = fName & " " & lName    'Combine first and last name into one cell
            
        Case firstDotlast
            FullName = Split(FullName, ",")      'Split the name passed in from the passed in arguments at the space
            lName = Trim(FullName(0))        'Trim leading and trailing spaces around the first name if there are any
            FullName = Split(Trim(FullName(1)))  'Get to the first name
            fName = Trim(FullName(0))         'Trim leading and trailing spaces around the last name if there are any
    
            'Convert to lowercase and return the combined name
            UserNameFunc = LCase(fName) & "." & LCase(lName)
    End Select
    
End Function


Let me know if you think it could be made better!

Thanks!
-BR
 
Upvote 0
Solution
I can't spare the time now to go through your code, but is seems that you've discovered some quirks and if it works, then it must be ok.
Basically you need to delete and replace the current file from outside and it must be closed at this this time. Closing it unfortunately kills the newly started process so you detach from it with application.ontime.

Are you facing some issues or getting errors?

If you have some time:
below is some code I played with some time ago related to this.
Feel free to examine it or play with it:
create file aaa.xlsm and put this code in a module:
VBA Code:
Option Explicit

Sub testSaveAs()
    Dim wb1 As String, wb2 As String, wbPath As String
    Dim newWb As String
    wbPath = ThisWorkbook.Path
    wb1 = ThisWorkbook.Name
    If wb1 = "aaa.xlsm" Then
        newWb = "bbb.xlsm"
    Else
        newWb = "aaa.xlsm"
    End If
    Debug.Print Now, ThisWorkbook.Name
    On Error Resume Next
    ThisWorkbook.SaveAs wbPath & "\" & newWb, xlOpenXMLWorkbookMacroEnabled
    If Err <> 0 Then
        MsgBox Err.Number & ": " & Err.Description & vbLf & _
            "Procedure will now exit.", vbCritical
        Err.Clear
        Exit Sub
    End If
        
    wb2 = ThisWorkbook.Name
    Debug.Print Now, ThisWorkbook.Name, "(after saveAs)"
    ActiveSheet.Calculate
    Kill wbPath & "\" & wb2
    If Err <> 0 Then
        'Stop
        MsgBox Err.Number & ": " & Err.Description & vbLf & _
                "Cannot delete file " & vbLf & wb2
        Err.Clear
    Else
        MsgBox "File deleted: " & vbLf & wb2
    End If
    Kill wbPath & "\" & wb1
    If Err <> 0 Then
        'Stop
        MsgBox Err.Number & ": " & Err.Description & vbLf & _
                "Cannot delete file " & vbLf & wb1
        Err.Clear
    Else
        MsgBox "File deleted: " & vbLf & wb1
    End If
    
    Workbooks.Open wbPath & "\" & "ccc.xlsm"
    ActiveSheet.Calculate
    Application.Run "'ccc.xlsm'!testForeignCall", wb2
End Sub
in the same folder create file ccc.xlsm and put this code in a module in it:
VBA Code:
Option Explicit

Sub testForeignCall(callerWb As String)
    If ThisWorkbook.Name <> "ccc.xlsm" Then
        Debug.Print "Wrong environment: " & ThisWorkbook.Name
        Exit Sub
    End If
    Dim x As VbMsgBoxResult, callerPath As String
    callerPath = Workbooks(callerWb).FullName
    x = MsgBox("Procedure called externally from: " & vbLf & callerPath & vbLf & _
                 "Do you want to close the calling workbook?", vbYesNo + vbQuestion, ThisWorkbook.Name)
    If x = vbYes Then
        Application.OnTime Now() + TimeValue("00:00:02"), "'killfile """ & callerPath & """'"
        Workbooks(callerWb).Close True
    End If
End Sub

Sub killFile(filePath As String)
    Dim x As VbMsgBoxResult
    x = MsgBox("Do you want to delete the calling workbook?" & vbLf & filePath, _
                 vbYesNo + vbQuestion, ThisWorkbook.Name)
    If x = vbYes Then
        On Error Resume Next
        Kill filePath
        If Err <> 0 Then
            MsgBox Err.Number & ": " & Err.Description & vbLf & _
                    "Cannot delete file " & vbLf & filePath
            Err.Clear
        Else
            MsgBox "File deleted: " & vbLf & filePath
        End If
    End If
End Sub
then start procedure testSaveAs from aaa.xlsm
 
Upvote 0
I can't spare the time now to go through your code, but is seems that you've discovered some quirks and if it works, then it must be ok.
Basically you need to delete and replace the current file from outside and it must be closed at this this time. Closing it unfortunately kills the newly started process so you detach from it with application.ontime.

Are you facing some issues or getting errors?

If you have some time:
below is some code I played with some time ago related to this.
Feel free to examine it or play with it:
create file aaa.xlsm and put this code in a module:
VBA Code:
Option Explicit

Sub testSaveAs()
    Dim wb1 As String, wb2 As String, wbPath As String
    Dim newWb As String
    wbPath = ThisWorkbook.Path
    wb1 = ThisWorkbook.Name
    If wb1 = "aaa.xlsm" Then
        newWb = "bbb.xlsm"
    Else
        newWb = "aaa.xlsm"
    End If
    Debug.Print Now, ThisWorkbook.Name
    On Error Resume Next
    ThisWorkbook.SaveAs wbPath & "\" & newWb, xlOpenXMLWorkbookMacroEnabled
    If Err <> 0 Then
        MsgBox Err.Number & ": " & Err.Description & vbLf & _
            "Procedure will now exit.", vbCritical
        Err.Clear
        Exit Sub
    End If
       
    wb2 = ThisWorkbook.Name
    Debug.Print Now, ThisWorkbook.Name, "(after saveAs)"
    ActiveSheet.Calculate
    Kill wbPath & "\" & wb2
    If Err <> 0 Then
        'Stop
        MsgBox Err.Number & ": " & Err.Description & vbLf & _
                "Cannot delete file " & vbLf & wb2
        Err.Clear
    Else
        MsgBox "File deleted: " & vbLf & wb2
    End If
    Kill wbPath & "\" & wb1
    If Err <> 0 Then
        'Stop
        MsgBox Err.Number & ": " & Err.Description & vbLf & _
                "Cannot delete file " & vbLf & wb1
        Err.Clear
    Else
        MsgBox "File deleted: " & vbLf & wb1
    End If
   
    Workbooks.Open wbPath & "\" & "ccc.xlsm"
    ActiveSheet.Calculate
    Application.Run "'ccc.xlsm'!testForeignCall", wb2
End Sub
in the same folder create file ccc.xlsm and put this code in a module in it:
VBA Code:
Option Explicit

Sub testForeignCall(callerWb As String)
    If ThisWorkbook.Name <> "ccc.xlsm" Then
        Debug.Print "Wrong environment: " & ThisWorkbook.Name
        Exit Sub
    End If
    Dim x As VbMsgBoxResult, callerPath As String
    callerPath = Workbooks(callerWb).FullName
    x = MsgBox("Procedure called externally from: " & vbLf & callerPath & vbLf & _
                 "Do you want to close the calling workbook?", vbYesNo + vbQuestion, ThisWorkbook.Name)
    If x = vbYes Then
        Application.OnTime Now() + TimeValue("00:00:02"), "'killfile """ & callerPath & """'"
        Workbooks(callerWb).Close True
    End If
End Sub

Sub killFile(filePath As String)
    Dim x As VbMsgBoxResult
    x = MsgBox("Do you want to delete the calling workbook?" & vbLf & filePath, _
                 vbYesNo + vbQuestion, ThisWorkbook.Name)
    If x = vbYes Then
        On Error Resume Next
        Kill filePath
        If Err <> 0 Then
            MsgBox Err.Number & ": " & Err.Description & vbLf & _
                    "Cannot delete file " & vbLf & filePath
            Err.Clear
        Else
            MsgBox "File deleted: " & vbLf & filePath
        End If
    End If
End Sub
then start procedure testSaveAs from aaa.xlsm
Thanks for all the code, and help!

My code actually runs great, it does exactly what I need it to do, and prevents my technicians from running the old one. But I am going to put some of this all in my back pocket for later, because this is too nice not to reuse! Plus I am putting it here and maybe put somewhere else on the forum so that someone else can reference this later and not ride the struggle bus like I did! Haha

Just really excited since the last time I actually used visual basic was a decade ago, and I "took a class" on this and you got an A (100%) for showing up.

I really appreciate all your help!
 
Upvote 0
Try this
VBA Code:
Option Explicit


Const mREMOTEPATH As String = "\\NetworkDrive\Automated RMA Traveler Files\Traveler\"
Const mTEXTFILENAME As String = "Current version.txt"

'The Text file only contains 1 line - Revision number, e.x. 1.19
'The location of "Current version.txt" is the same as mREMOTEPATH
'The mREMOTEPATH location also contains the new version of the workbook
'The new version of the workbook has the same name as the currently used workbook (ThisWorkbook.Name)


Sub CheckForUpdates()
    Dim FileNumber As Integer
    Dim strCurntVerFile As String
    Dim strOriginFileName As String
    Dim strOriginPath As String
    Dim strRemoteFileName As String
    Dim dblCurntVer As Double

    strOriginFileName = ThisWorkbook.FullName
    strOriginPath = ThisWorkbook.Path & Application.PathSeparator

    strCurntVerFile = mREMOTEPATH & mTEXTFILENAME

    If Len(Dir(strCurntVerFile)) = 0 Then Exit Sub

    FileCopy strCurntVerFile, strOriginPath & mTEXTFILENAME

    FileNumber = FreeFile

    On Error Resume Next
    Open (strOriginPath & mTEXTFILENAME) For Input As #FileNumber
    Input #FileNumber, dblCurntVer
    Close #FileNumber

    Kill (strOriginPath & mTEXTFILENAME)
    On Error GoTo 0

    If dblCurntVer = 0 Then
        'No revision number?
        Exit Sub
    End If

    If dblCurntVer > CDbl([Update_Rev]) Then
        If MsgBox("An update is available. Click 'OK' to overwrite" & _
                  " the current local version with the newest version.", vbOKCancel) = vbOK Then

            strRemoteFileName = mREMOTEPATH & ThisWorkbook.Name

            Call UpdateVersion(strOriginFileName, strRemoteFileName)

            [Update_Rev] = dblCurntVer
        End If
    End If

End Sub


Sub UpdateVersion(FileFullName As String, RemoteFileName As String)

    ThisWorkbook.SaveAs Filename:=Replace(FileFullName, ".xlsm", "_tmp.xlsm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled

    'The macro is continued to be executed, but already in a file with a new name (*_tmp.xlsm)

    Kill FileFullName

    FileCopy RemoteFileName, FileFullName

    'opening the updated version of the file under the original name
    Application.EnableEvents = False
    Workbooks.Open FileFullName
    Application.EnableEvents = True

    'suicide file *_tmp.xlsm
    With ThisWorkbook
        .Saved = True
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
End Sub

Artik
 
Upvote 0

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,398
Latest member
rjsteward

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top