4

I'm trying to use the following VBA code snippet to open an Excel file as a data source:

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=" & path & "\" & VFile & ";" & _
        "Extended Properties=""Excel 8.0; HDR=No; IMEX=1;"""
    .Open
End With

This works as expected when the path variable is of the type C:\Folder. However, if I want to reference an excel file in the same folder as the current file, and use

path = ThisWorkbook.path

where the current workbook is in a folder stored on SharePoint, path will then contain something of the form

https://sp.foobar.com/folder

Trying to connect using this path results in a Method 'Open' failed error. Hacking the path into a WebDAV path tells me that the file is either locked or I do not have permission to read it.

Can anyone help?

When I manually set path to the Drive:\Folder form, all is well, but I can't automatically generate this path using ThisWorkbook.path or similar if the file is stored on SharePoint, and I'd like the solution to be 'portable' in the sense of working anywhere on a drive so long as all the relevant files are in the same folder.

Matti Wens
  • 740
  • 6
  • 24

3 Answers3

5

When connecting to an excel file on sharepoint you have to change some details in the path. Specifically, removing "http:" at the start, substituting "/" for "\", and substituting any spaces with "%20".

The following VBA code checks if the file path includes "http" and if it does it performs the above substitutions and returns a string (ExcelWorkbook) that ADODB can read.

If InStr(ThisWorkbook.FullName, "http:") = 0 Then ExcelWorkbook = ThisWorkbook.FullName Else ExcelWorkbook = Replace(Replace(Replace(ThisWorkbook.FullName, "/", "\"), " ", "%20"), "http:", "")

I don't know why it works when this change is made, but it definitely does!

Willow
  • 66
  • 1
  • 2
2

This doesn't work anymore, but I found a solution for this problem. The assignment of Sharepoint libraries to local mountpoints is stored in the registry, the following function will convert the URL to a local filename:

Public Function GetLocalFile(wb As Workbook) As String
    Const HKEY_CURRENT_USER = &H80000001
    Dim temp As Object
    Dim rPath As String
    Dim arrSubKeys() As Variant
    Dim strAsk As Variant
    Dim strValue As String
    Dim strMountpoint As String

    Set temp = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

    rPath = "Software\SyncEngines\Providers\OneDrive\"
    temp.EnumKey HKEY_CURRENT_USER, rPath, arrSubKeys
    For Each strAsk In arrSubKeys
        temp.getStringValue HKEY_CURRENT_USER, rPath & strAsk, "UrlNamespace", strValue
        If InStr(wb.FullName, strValue) > 0 Then
            temp.getStringValue HKEY_CURRENT_USER, rPath & strAsk, "MountPoint", strMountpoint
            GetLocalFile = strMountpoint & "\" & Replace(Right(wb.FullName, Len(wb.FullName) - Len(strValue)), "/", "\")
            Exit Function
        End If
    Next
    GetLocalFile = wb.FullName
End Function
beerockxs
  • 74
  • 4
  • As long as the excel file in question is synced locally, such a solution can indeed be used. This solution does not work for all cases of OneDrive/Sharepoint however. If you are looking for a solution to get the local path from `ThisWorkbook.Path` for synchronized files, please look at [this answer](https://stackoverflow.com/a/73577057/12287457). – GWD Sep 26 '22 at 13:23
0

This code worked in my case as of November 2021. This assumes you have a sheet called "PATHS" and a table that contains a "Retailer" field.

Private Sub ConnectToDatabase()

'VERY VERY IMPORTANT: FILE NEEDS TO BE SAVED FOR ADO TO DETECT CHANGES. ANY CHANGES WITH NO SAVE WILL NOT BE REFLECTED <<<<<<<<<<<<<<<<<

'ESTABLISH ADO CONNECTION
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

StrFile = Convert_HTTP_To_NetworkPath(ThisWorkbook.FullName) 
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & StrFile & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set DATABASE = CreateObject("ADODB.Connection")
Set RST = CreateObject("ADODB.Recordset")

DATABASE.Open strCon
'UserForm4.Hide


'FOR TESTING ONLY
TEST_CONNECTION = True
If TEST_CONNECTION = True Then
    SQL = "SELECT * FROM [PATHS$]"
    RST.Open SQL, DATABASE, adOpenStatic, adLockReadOnly
        RST.MoveLast
        Result = MsgBox(RST.Fields("RETAILER"), vbInformation)
    RST.Close
End If

End Sub



Function Convert_HTTP_To_NetworkPath(URL)
    
    Result = URL
    Result = Replace(Result, "%20", " ")
    Result = Replace(Result, "https://mycompany.sharepoint.com", "\\mycompany.sharepoint.com@SSL\DavWWWRoot")
    Result = Replace(Result, "/", "\")
    If IsIn(".", Right(Result, 5)) = False And Right(Result, 1) <> "\" Then Result = Result & "\"
    Convert_HTTP_To_NetworkPath = Result
    
End Function

Function IsIn(Keyword, Text)

    If UCase(Text) Like "*" & UCase(Keyword) & "*" Then IsIn = True Else IsIn = False
    
End Function
Chadee Fouad
  • 2,630
  • 2
  • 23
  • 29