Consulting

Results 1 to 3 of 3

Thread: Solved: Only do if not read only.

  1. #1

    Solved: Only do if not read only.

    Private Sub SITE()
        Application.EnableEvents = False
        
            Dim i As Integer, wb As Workbook
        
                With Application.FileSearch
                    .NewSearch
                    .LookIn = "\\Uk3\traner\jj\UK\Edirgh\"
                    .SearchSubFolders = True
                    .Filename = "*.xls"
                    .Application.DisplayAlerts = False
                    .Execute
                For i = 1 To .FoundFiles.Count
                
    ActiveWorkbook.Name
        
             Set wb = Workbooks.Open(Filename:=.FoundFiles(i), ReadOnly:=False)
                   
        Sheets("CallData").Select
        ActiveSheet.Unprotect Password:="54YY4F"
        If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
        Range("B1").FormulaR1C1 = "12/3/2008 12:00"
        
            wb.Close savechanges:=True
        
        Next i
        End With
        Application.EnableEvents = True
             
        
    End Sub
    I have the above script, I need it only run if the workbook is not in readonly and save the file , if it is readonly then simply close the file without save...

  2. #2
    VBAX Expert
    Joined
    Feb 2005
    Location
    Nanaimo, British Columbia, Cananda
    Posts
    568
    Location
    khalid,

    Seems to work:

    [VBA]
    'Get file attributes (1 = readonly)
    Ronly = GetAttr(.FoundFiles(i)) Mod 2
    [/VBA]

    ReadOnly attribute = 1 and is the only odd number. So Mod 2 leaves 1 if readonly, 0 if not. See below:

    [VBA]
    Option Explicit
    Private Sub SITE()

    Dim i As Long
    Dim Ronly As Long
    Dim WB As Workbook

    'No recursion/Warnings
    With Application
    .EnableEvents = False
    .DisplayAlerts = False
    End With

    'Find file(s)
    With Application.FileSearch
    .NewSearch
    .LookIn = "c:\" '"\\Uk3\traner\jj\UK\Edirgh\"
    .SearchSubFolders = False 'True
    .Filename = "*.xls"
    .Execute
    For i = 1 To .FoundFiles.Count

    '//???
    'ActiveWorkbook.Name

    'Get file attributes (1 = readonly)
    Ronly = GetAttr(.FoundFiles(i)) Mod 2

    ' If Not User = "adamant" & " " & "hater" of the dreaded GoTo Then
    ' Echo "<G>"
    ' Else
    ' change it to an 'IF'
    ' End If

    'Is read only, skip it
    If Ronly = 1 Then GoTo NextFile

    'Open file
    Set WB = Workbooks.Open(Filename:=.FoundFiles(i), ReadOnly:=False)
    'Set active sheet
    Sheets("CallData").Select
    With ActiveSheet
    'Do stuff
    .Unprotect Password:="54YY4F"
    If .AutoFilterMode = True Then
    .AutoFilterMode = False
    Range("B1").FormulaR1C1 = "12/3/2008 12:00"
    '//Reprotect sheet?
    .Protect Password:="54YY4F"
    'Close with changes saved
    WB.Close savechanges:=True
    Else
    '//Reprotect sheet?
    .Protect Password:="54YY4F"
    '//Just close
    With WB
    .Saved = True
    .Close
    End With
    End If
    End With
    'Skip Read only file
    NextFile:
    Next i
    End With

    'Reset BOTH
    With Application
    .EnableEvents = True
    .DisplayAlerts = True
    End With

    'Destroy object
    Set WB = Nothing

    End Sub

    [/VBA]
    Cheers,

    dr

    "Questions, help and advice for free, small projects by donation. large projects by quote"

    http:\\www.ExcelVBA.joellerabu.com

  3. #3
    Thanks I havent had chance to impliment this properly but it seems to work thankyou

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •