CODEWITHSUNDEEP
excelvbaexcel-2003
bsiilvia
bsiilvia

Reputation: 97

VBA Excel: How to remove READ-ONLY attribute from the actual file?

I have to edit an excel file with vba code for an old Excel 2003 pack in an old machine. I have the necessity to check, while opening the file, if it has "read-only" attribute. If yes I have to remove this attribute and save the file itself in the same location,like overwriting it, by removing the read-only version to an editable one.

I wrote this function to remove the READ-ONLY:

Sub RemoveReadOnly(filePath As String)
    Dim FSO As Object
    Dim file As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set file = FSO.GetFile(filePath)

    If file.Attributes And 1 Then '1 = ReadOnly
        file.Attributes = file.Attributes - 1
    End If
End Sub

Then in the Workbook_Open function i added this code:

If ThisWorkbook.ReadOnly Then            
     Application.DisplayAlerts = False  
   
     RemoveReadOnly wb.FullName 'wb = ThisWorkbook
     ThisWorkbook.SaveAs ThisWorkbook.FullName, ReadOnlyRecommended:=False

     Application.DisplayAlerts = True
End If

I'm sure i'm missing something or maybe I have to try a different way out.

Can someone help me overwriting the file itself or give me another way rather the one I'm trying to develop?

Thank you guys.

Upvotes: 0

Views: 92

Answers (1)

bsiilvia
bsiilvia

Reputation: 97

I found a solution that also manage if the READ-ONLY attribute is set on the file parent folder.

To check if the function RemoveReadOnly worked without errors I set up a variable Dim checkDirAttr As Boolean and manages as you can see in the code here:

Sub RemoveReadOnly(filePath As String)
    Dim FSO As Object
    Dim file As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set file = FSO.GetFile(filePath)
    
    On Error GoTo Errore
    If file.Attributes And 1 Then '1 = ReadOnly
        file.Attributes = file.Attributes - 1
    End If
    
Errore:
    checkDirAttr = True 
    MsgBox "There's a problem!"
    Exit Sub
End Sub

As you can see I set the checkDirAttr to true if I got an error like when the file folder is inaccessible.

In my Workbook_Open sub I used this code:

If ThisWorkbook.ReadOnly Then
        Application.DisplayAlerts = False
        'get the current file path
        oldFile = ThisWorkbook.FullName
        'get and save the path for my temp file
        sDefaultFilePath = Application.DefaultFilePath
        sFilePath = sDefaultFilePath & "\TEMP-FILE.xls"            
        
        'call my function to remove the READ-ONLY attribute
        RemoveReadOnly wb.FullName
        'check if I got some errors, if not...
        If checkDirAttr = False Then
            'save a copy of my current file to the Excel default folder 
            wb.SaveAs sFilePath
            'Set a temp workbook with the current one so I can take the code open and running
            Set wbAppo = ActiveWorkbook
            'open the original file again but without the READ-ONLY attribute
            Application.OnTime Now + TimeValue("00:00:05"), Application.Workbooks.Open(oldFile)
            
            'close the temp workbook
            If Application.Workbooks.Count = 1 Then
                Application.Quit
            Else
                wbAppo.Close SaveChanges:=False
            End If
            
            Application.DisplayAlerts = True
        End If
    End If

Hope this will help someone else that could need to solve the same kind of issue.

Thank you again for the support!

Upvotes: 0

Related Questions