Excel vba to check if a sharepoint file is in use/editable

[anas979]

I have some files in company sharepoint network. I am using a local excel vba script to open and edit those files.

Set wb = Workbooks.Open("http://XXXX/XXXXX.xlsm")
wb.LockServerFile

The above code works fine when the file is available (file not in used by other colleagues). When the file is in use, it brings a popup saying:

File In Use
This file is locked for editing by XXXXX
Do you want to:
-View a read-only copy
-Save and edit a copy of the file
-Receive a notification when the server file is available

I am looking for a way to check if the file is editable before opening the file and before running wb.LockServerFile. Something like this:

If FileEditable("http://XXXX/XXXXX.xlsm") = True Then
Set wb = Workbooks.Open("http://XXXX/XXXXX.xlsm")
wb.LockServerFile
Else
'Log the filename, do something else, try again later...
End If

I have tried Workbooks.CanCheckOut("http://XXXX/XXXXX.xlsm") but it always return True. I have tried Open FileName For Binary Access Read Write Lock Read Write As #1 but the Open statement returns runtime error 52 for bad filename. I believe it was due to special characters since my filepath is a network address

 

[Micron]

I've had limited experience dealing with SP vs Excel and can only say that I have used CanCheckOut with success so I can only imagine that at the SP end, the administrator did not require that users must exclusively check out files when opening them. That might be something you'd want to look into. I have read about where the return value is always False (reportedly because you have the file already open in an instance of Excel, but it seems you have the opposite problem.

Perhaps post more of the procedure, because AFAIK, you must test for checkout, then checkout, then open. If you're missing one of those steps, that might be your issue, but that part of the code is missing from your post.

 

[HowdyKeith]

Global Const PAFileN As String = "http://teams.MyCompany.com/sites/CompFolder/SubF/SubF/Forms/AllItems.aspx"
Public Const spurl As String = "http://teams.MyCompany.com/sites/CompFolder/SubF/SubF/Forms/"

Sub testCheckedByWho()
    Debug.Print CheckedByWho("2022_MyFile_Sample.xlsx")
End Sub

Function CheckedByWho(ShareFileName As String, Optional spurl As String) As String
    Dim request As Object
    Dim PagesHTML As String
    Dim CheckedWho As String
    Dim CheckStart, CheckEnd As Integer

    Const StartCode = 89415
    Const EndCode = 23436

    If spurl = "" Then spurl = PAFileN

    Set request = CreateObject("MSXML2.XMLHTTP")
    request.Open "Get", spurl, False
    request.Send

    PagesHTML = Mid(StrConv(request.responseBody, vbUnicode), StartCode)
    PagesHTML = Mid(PagesHTML, 1, Len(PagesHTML) - EndCode)
    
    CheckedOutPos = InStr(1, PagesHTML, "u002f" & ShareFileName, vbTextCompare)
    
    If CheckedOutPos < 1 Then
        xCheckedByWho = "Not Found"
'Debug.Print "!!"
        Exit Function
    End If

'"CheckoutUser": "", <- not
'"CheckoutUser": [{"id":"439","title":"Joe Smith", <- is

    CheckStart = InStr(CheckedOutPos, PagesHTML, Chr(34) & "CheckoutUser" & Chr(34) & ": ")
    If Mid(PagesHTML, CheckStart + 16, 1) <> "[" Then
        CheckedByWho = "Not Check Out"
        Exit Function
    End If

    CheckStart = InStr(CheckStart, PagesHTML, Chr(34) & "title" & Chr(34) & ":" & Chr(34))
    CheckEnd = InStr(CheckStart + 9, PagesHTML, Chr(34) & "email")

'Debug.Print "Inr: " & Mid(PagesHTML, CheckStart + 9, CheckEnd - CheckStart - 11) 'CheckEnd - CheckStart - 10)

    CheckedByWho = Mid(PagesHTML, CheckStart + 9, CheckEnd - CheckStart - 11)
End Function

 

[HowdyKeith]

Global Const PAFileN As String = "http://teams.MyCompany.com/sites/CompFolder/SubF/SubF/Forms/AllItems.aspx"
Public Const spurl As String = "http://teams.MyCompany.com/sites/CompFolder/SubF/SubF/Forms/"

Sub testCheckedByWho()
    Debug.Print CheckedByWho("2022_MyFile_Sample.xlsx")
End Sub

Function CheckedByWho(ShareFileName As String, Optional spurl As String) As String
    Dim request As Object
    Dim PagesHTML As String
    Dim CheckedWho As String
    Dim CheckStart, CheckEnd As Integer

    Const StartCode = 89415
    Const EndCode = 23436

    If spurl = "" Then spurl = PAFileN

    Set request = CreateObject("MSXML2.XMLHTTP")
    request.Open "Get", spurl, False
    request.Send

    PagesHTML = Mid(StrConv(request.responseBody, vbUnicode), StartCode)
    PagesHTML = Mid(PagesHTML, 1, Len(PagesHTML) - EndCode)
   
    CheckedOutPos = InStr(1, PagesHTML, "u002f" & ShareFileName, vbTextCompare)
   
    If CheckedOutPos < 1 Then
        xCheckedByWho = "Not Found"
'Debug.Print "!!"
        Exit Function
    End If

'"CheckoutUser": "", <- not
'"CheckoutUser": [{"id":"439","title":"Joe Smith", <- is

    CheckStart = InStr(CheckedOutPos, PagesHTML, Chr(34) & "CheckoutUser" & Chr(34) & ": ")
    If Mid(PagesHTML, CheckStart + 16, 1) <> "[" Then
        CheckedByWho = "Not Check Out"
        Exit Function
    End If

    CheckStart = InStr(CheckStart, PagesHTML, Chr(34) & "title" & Chr(34) & ":" & Chr(34))
    CheckEnd = InStr(CheckStart + 9, PagesHTML, Chr(34) & "email")

'Debug.Print "Inr: " & Mid(PagesHTML, CheckStart + 9, CheckEnd - CheckStart - 11) 'CheckEnd - CheckStart - 10)

    CheckedByWho = Mid(PagesHTML, CheckStart + 9, CheckEnd - CheckStart - 11)
End Function

Reading through your post, I wonder if you are looking to test on a Sharepoint site, or just open a file on your network.

I posted my Test if Locked on Sharepoint code. And my Checkout and Checkin code.

 

[HowdyKeith]

Sub PA_CheckOut(docCheckOut As String)
   Set mXlApp = CreateObject("Excel.Application")
' Determine if workbook can be checked out.

    If mXlApp.Workbooks.CanCheckOut(docCheckOut) = True Then
        mXlApp.Workbooks.Open Filename:=docCheckOut
'        Workbooks.Open fileName:=docCheckOut
On Error Resume Next
        mXlApp.Workbooks.CheckOut docCheckOut
        mXlApp.Visible = False

        mXlApp.Quit
   Set mXlApp = Nothing
   Dim location As String
   Dim wbk As Workbook

'TestWho

    Workbooks.Open Filename:=docCheckOut
    
    End If
End Sub

Sub SPCheckIn(CheckName As String, CheckPath As String)


' Must be open to save and then checkin

    If CheckedByWho(PAFileN, PAFileName) = "Not Check Out" Then
        Exit Sub
    End If
 
 If WorkbookIsOpen(CheckName) = False Then
 
  Set wb = Workbooks.Open(CheckPath)

    End If

' https://wellsr.com/vba/2021/excel/vba-getattr/
Dim myFile As String
Dim iReadOnly As Integer
myFile = CheckPath
iReadOnly = GetAttr(CheckName) And vbReadOnly
If iReadOnly <> 0 Then
    'File is read-only
    Debug.Print "iReadOnly"
Else
    'File is not read-only
    Debug.Print "not iReadOnly"
Debug.Print iReadOnly And (vbHidden + vbReadOnly)
End If


wb.checkin savechanges:=True, Comments:=""
TestWho

End Sub