TheEnginerd
New Member
- Joined
- Jul 22, 2024
- Messages
- 4
- Office Version
- 365
- Platform
- 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.
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