So my computer is very slow in the Windows Explorer and I was looking to use the OneDrive (SkyDrive) to backup files. To force a synchronisation one right clicks on the OneDrive icon and selects 'Sync' but this menu is very very slow to appear to for me currently and I was wondering if it could be coded in VBA.
I found a StackOverflow answer which points to a nice JavaScript file on GitHub that uses the 'Microsoft Shell Controls and Automation' type library (albeit late binding). I have converted the code to VBA. The code gets the OneDrive folder item, and uses the Verbs method to get the list that appears when one right clicks to get context menu. To mimic pressing a menu option one calls DoIt on the Verb object.
I am curious to investigate how to add functionality to the Shell namespace now that I have discovered how to invoke such functionality. In the meantime here is some code.
Option Explicit
Option Private Module
'*Tools->References
'* Microsoft Scripting Runtime C:\Windows\sysWOW64\scrrun.dll
'* Microsoft Shell Controls and Automation C:\Windows\sysWOW64\shell32.dll
Private Sub TestSyncItem()
SyncItem ""
End Sub
Private Sub SyncItem(Optional ByVal sItemName As String)
'* Based on https://github.com/npocmaka/batch.scripts/blob/master/hybrids/jscript/oneDriveSync.bat
Dim objFSO As New Scripting.FileSystemObject
Dim objShell As New Shell32.Shell 'ActiveXObject("Shell.Application");
If LenB(sItemName) = 0 Then sItemName = GetOneDrivePathFromReg
If objFSO.FolderExists(sItemName) Or objFSO.FileExists(sItemName) Then
Dim sFullItemName As String
sFullItemName = objFSO.GetAbsolutePathName(sItemName)
Dim sNamespace As String
sNamespace = objFSO.GetParentFolderName(sFullItemName)
Dim sName As String
sName = objFSO.GetFolder(sFullItemName).name
'* Introduction to the Shell Namespace
'* https://msdn.microsoft.com/en-us/library/windows/desktop/cc144090(v=vs.85).aspx
Dim objFolder As Shell32.Folder
Set objFolder = objShell.namespace(sNamespace)
Dim objItem As Shell32.FolderItem
Set objItem = objFolder.ParseName(sName)
Dim oFolderItemVerb As Shell32.FolderItemVerb
Set oFolderItemVerb = Nothing
Dim vVerbLoop As Variant
For Each vVerbLoop In objItem.Verbs
If vVerbLoop.name = "Sync" Then
Set oFolderItemVerb = vVerbLoop
Exit For
End If
Next vVerbLoop
If Not oFolderItemVerb Is Nothing Then
Call oFolderItemVerb.DoIt
End If
Stop
End If
End Sub
Private Function GetOneDrivePathFromReg() As String
Const HKCU As Long = &H80000001
Dim registryObject As Object
Set registryObject = VBA.GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
".\root\default:StdRegProv")
Dim sRet As String
registryObject.GetStringValue HKCU, "Software\Microsoft\OneDrive", "UserFolder", sRet
GetOneDrivePathFromReg = sRet
End Function
I just download and use "Long Path Tool" to fix your error fast and easy.
ReplyDelete