I would like to run SQL queries on tables all contained within a single Excel workbook. My VBA code uses ADODB to run these SQL queries.
Opening connection fails when the workbook is saved in OneDrive, but works when workbook is saved to a local drive.
How can I run SQL on tables within a single excel workbook, while saved on OneDrive?
The code works when the book is saved locally but not on OneDrive. The only change is the file path which looks fairly different in each case:
OneDrivePathExample = "https://d.docs.live.net/....xlsb"
LocalPathExample = "C:\My Documents\....xlsb"
I've experimented with a few things around the file path in the connection string but, unsurprisingly, they didn't work:
Original
Provider=Microsoft.ACE.OLEDB.12.0;Data Source=https://d.docs.live.net/.../Documents/Financial Tracker.xlsb;Extended Properties="Excel 12.0;HDR=Yes;IMEX=1";
Replacing "/" with "\"
Provider=Microsoft.ACE.OLEDB.12.0;Data Source=https:\\d.docs.live.net\...\Documents\Financial Tracker.xlsb;Extended Properties="Excel 12.0;HDR=Yes;IMEX=1";`
Adding square brackets around path
Provider=Microsoft.ACE.OLEDB.12.0;Data Source=[https://d.docs.live.net/.../Documents/Financial Tracker.xlsb];Extended Properties="Excel 12.0;HDR=Yes;IMEX=1";
Adding quotes around path
Provider=Microsoft.ACE.OLEDB.12.0;Data Source="https://d.docs.live.net/.../Documents/Financial Tracker.xlsb";Extended Properties="Excel 12.0;HDR=Yes;IMEX=1";
I realize that I can avoid this by saving it locally when running this code, and then save it back to OneDrive afterwards but I would like to avoid this if possible.
I also realize that I can write VBA code that does what I'm trying to do with SQL, however I did that originally but switched to the SQL method because SQL was way faster.
Here's my code:
Function OpenRST(strSQL As String) As ADODB.Recordset
''Returns an open recordset object
Dim cn As ADODB.Connection
Dim strProvider As String, strExtendedProperties As String
Dim strFile As String, strCon As String
strFile = ThisWorkbook.FullName
strProvider = "Microsoft.ACE.OLEDB.12.0"
strExtendedProperties = """Excel 12.0;HDR=Yes;IMEX=1"";"
strCon = "Provider=" & strProvider & _
";Data Source=" & strFile & _
";Extended Properties=" & strExtendedProperties
Set cn = CreateObject("ADODB.Connection")
Set OpenRST = CreateObject("ADODB.Recordset")
cn.Open strCon ''This is where it fails
OpenRST.Open strSQL, cn
End Function
On the cn.Open strCon
line, the following error appears:
Run-time error '-2147467259 (80004005)';
Method 'Open' of object '_Connection' failed
Thanks!
this is my solution to get file path.
'This Function search root folder as C: ,D: ...
'Search into all OneDrive folders
Option Explicit
Private Const strProtocol As String = "Http"
Private Const pathSeparator As String = "\"
Function MainFindFile(ByRef NullFilePath As String, Optional FileName As String) As Boolean
Dim fso As FileSystemObject 'Necessary enable microsoft scripting runtime in references
Dim UserRootFolder As Folder
Dim SecondSubFolders As Folder
Dim ThirdSubFolders As Folder
Dim InitialPath As String
Dim OneDriveFolderName As String
Set fso = New Scripting.FileSystemObject
InitialPath = ActiveWorkbook.FullName
If FileName = vbNullString Then FileName = ActiveWorkbook.Name
If InStr(1, InitialPath, strProtocol, vbTextCompare) > 0 Then
InitialPath = Environ("SystemDrive")
InitialPath = InitialPath & Environ("HomePath")
'Gets all folders in user root folder
Set UserRootFolder = fso.GetFolder(InitialPath)
For Each SecondSubFolders In UserRootFolder.SubFolders
'Searches all folders of OneDrive, you may have how many Onedrive's folders as you want
If InStr(1, SecondSubFolders.Name, "OneDrive", vbTextCompare) > 0 Then
OneDriveFolderName = InitialPath & pathSeparator & SecondSubFolders.Name
'Verifies if file exists in root of Onedrive Folder
MainFindFile = SearchFile(OneDriveFolderName, FileName, NullFilePath)
If MainFindFile Then Exit For
'Uses recursive function to percur all subfolders in root of OneDrive
For Each ThirdSubFolders In fso.GetFolder(OneDriveFolderName).SubFolders
MainFindFile = RecursiveFindFile(ThirdSubFolders, FileName, NullFilePath)
If MainFindFile Then Exit For
Next ThirdSubFolders
End If
If MainFindFile Then Exit For
Next SecondSubFolders
End If
MsgBox NullFilePath
End Function
Private Function RecursiveFindFile(Folder As Folder, FileName As String, ByRef NullFilePath As String) As Boolean
Dim fso As FileSystemObject
Dim objFolder As Folder
Dim Result As Boolean
Set fso = New Scripting.FileSystemObject
'Verifies if file exists in root of Onedrive Folder
RecursiveFindFile = SearchFile(Folder.Path, FileName, NullFilePath)
If RecursiveFindFile Then Exit Function
For Each objFolder In Folder.SubFolders
If Not SearchFile(objFolder.Path, FileName, NullFilePath) Then
RecursiveFindFile = RecursiveFindFile(objFolder, FileName, NullFilePath)
If RecursiveFindFile Then Exit For
Else
RecursiveFindFile = True
Exit For
End If
Next objFolder
End Function
Private Function SearchFile(Path As String, FileName As String, ByRef NullFilePath As String) As Boolean
'NullFilePath is a byref variable to be filled by this function
Dim fso As New Scripting.FileSystemObject
If fso.FileExists(Path & pathSeparator & FileName) Then
NullFilePath = Path & pathSeparator & FileName
SearchFile = True
End If
End Function
You can use the following function to convert the OneDrivePath
into a LocalPath
.
There are many solutions for this problem out there on the web, but almost none that work for all the different kinds of OneDrive accounts and folders... ( personal , business , business with SharePoint , synchronized folders from other people's OneDrives , etc.)
That's why I wrote this function which deals with all kinds of OneDrive mounts I have encountered so far.
Private Function GetLocalPath(path As String) As String
Const HKEY_CURRENT_USER = &H80000001
Dim objReg As Object
Dim regPath As String
Dim subKeys() As Variant
Dim subKey As Variant
Dim strValue As String
Dim strMountpoint As String
Dim strSecPart As String
Static pathSep As String
If pathSep = "" Then pathSep = Application.PathSeparator
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
regPath = "Software\SyncEngines\Providers\OneDrive\"
objReg.EnumKey HKEY_CURRENT_USER, regPath, subKeys
For Each subKey In subKeys
objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, _
"UrlNamespace", strValue
If InStr(path, strValue) > 0 Then
objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, _
"MountPoint", strMountpoint
strSecPart = Replace(Mid(path, Len(strValue)), "/", pathSep)
GetLocalPath = strMountpoint & strSecPart
Do Until Dir(GetLocalPath, vbDirectory) <> "" Or _
InStr(2, strSecPart, pathSep) = 0
strSecPart = Mid(strSecPart, InStr(2, strSecPart, pathSep))
GetLocalPath = strMountpoint & strSecPart
Loop
Exit Function
End If
Next
GetLocalPath = path
End Function
Note that you could in theory just use "\"
instead of Application.PathSeparator
because this problem only occurs on Windows and therefore this function is only necessary on Windows systems.
Replace the htpps: with "". This will bring you one step further.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.