Here is an quick example I tossed together. You will need to reference the Microsoft Scripting Runtime library.
Private Sub Command1_Click()
Dim fso As New FileSystemObject
Dim sPath As String
Dim sTempPath As String
Dim sFileName As String
Dim bRO As Boolean
Dim sFile As File
Dim sAttrib As FileAttribute
On Error GoTo ErrHnd
sTempPath = "C:\" 'Path of temp dir
sFileName = "Voting.gif" 'File to Check
sPath = "D:\Downloads\" 'Path of File to Check
'Get the file Attributes
Set sFile = fso.GetFile(sPath & sFileName)
sAttrib = sFile.Attributes
'Check the Read Only Property of the File
If BitOn(sAttrib, 1) Then
'Attempt to Change Read Only Property Error Trap in case of CD
sFile.Attributes = sAttrib - ReadOnly
End If
'bRO is Set to True in Error Trap If File is Read Only
If bRO Then
'Copy the File to a temp dir and Change the Read Only Property
sFile.Copy sTempPath & sFileName, True
Set sFile = fso.GetFile(sTempPath & sFileName)
sFile.Attributes = sAttrib - ReadOnly
End If
Set fso = Nothing
Set sFile = Nothing
Exit Sub
ErrHnd:
Select Case Err.Number
Case 70 'Permission Not Permitted for Read Only CD
bRO = True
Resume Next
Case Else
MsgBox Err.Number & " " & Err.Description & " Error Generated By " & Err.Source, vbCritical, "System Error Trap !"
End Select
End Sub
Private Function BitOn(Number As Long, Bit As Long) As Boolean
Dim iX As Long
Dim iY As Long
iY = 1
For iX = 1 To Bit - 1
iY = iY * 2
Next
If Number And iY Then BitOn = True Else BitOn = False
End Function
Hope this Helps. Good LuckPrivate Sub Command1_Click()
Dim fso As New FileSystemObject
Dim sPath As String
Dim sTempPath As String
Dim sFileName As String
Dim bRO As Boolean
Dim sFile As File
Dim sAttrib As FileAttribute
On Error GoTo ErrHnd
sTempPath = "C:\" 'Path of temp dir
sFileName = "Voting.gif" 'File to Check
sPath = "D:\Downloads\" 'Path of File to Check
'Get the file Attributes
Set sFile = fso.GetFile(sPath & sFileName)
sAttrib = sFile.Attributes
'Check the Read Only Property of the File
If BitOn(sAttrib, 1) Then
'Attempt to Change Read Only Property Error Trap in case of CD
sFile.Attributes = sAttrib - ReadOnly
End If
'bRO is Set to True in Error Trap If File is Read Only
If bRO Then
'Copy the File to a temp dir and Change the Read Only Property
sFile.Copy sTempPath & sFileName, True
Set sFile = fso.GetFile(sTempPath & sFileName)
sFile.Attributes = sAttrib - ReadOnly
End If
Set fso = Nothing
Set sFile = Nothing
Exit Sub
ErrHnd:
Select Case Err.Number
Case 70 'Permission Not Permitted for Read Only CD
bRO = True
Resume Next
Case Else
MsgBox Err.Number & " " & Err.Description & " Error Generated By " & Err.Source, vbCritical, "System Error Trap !"
End Select
End Sub
Private Function BitOn(Number As Long, Bit As Long) As Boolean
Dim iX As Long
Dim iY As Long
iY = 1
For iX = 1 To Bit - 1
iY = iY * 2
Next
If Number And iY Then BitOn = True Else BitOn = False
End Function
Anything is possible, the problem is I only have one lifetime.
![[cheers] [cheers] [cheers]](/data/assets/smilies/cheers.gif)