Abstract
Microsoft OneDrive ist ein Filehosting-Dienst von Microsoft. Mithilfe dieses Dienstes kann man Dateien hochladen und auch von anderen Diensten aus abrufen und bearbeiten.
Dieser Dienst beansprucht allerdings etwas Zeit, um Dateien zu synchronisieren. Die VBA Subroutine Check_OneDrive_Sync prüft, ob ein Programm bereits vollständig synchronisiert wurde (d.h. lauffähig ist).
Für die Erstellung oder Bearbeitung vieler Dateien empfiehlt es sich manchmal, OneDrive vorübergehend auszuschalten. Dies ermöglicht die VBA Subroutine ManageOnedriveSync.
Programmcode Check_OneDrive_Sync
Bitte beachten: Diese Subroutine benötigt das Modul (externer Link!) LibFileTools.
Bitte den Haftungsausschluss im Impressum beachten.
Sub Check_OneDrive_Sync()
'Checks whether report folder has been fully synchronized from Sharepoint to OneDrive.
'Die if not. 'Requires LibFileTools:
'https://github.com/cristianbuse/VBA-FileTools
'Version When Who What
' 1 24-Feb-2025 Bernd Plumhoff Initial version.
' 2 12-Aug-2025 Bernd Plumhoff Environ("OneDrive") instead of Environ("Username")
' 3 17-Mar-2026 Bernd Plumhoff GetLocalPath(ThisWorkbook.path) can be empty.
Dim sAppFolder As String
sAppFolder = GetLocalPath(ThisWorkbook.path)
If sAppFolder = "" Then sAppFolder = ThisWorkbook.path
If Right(sAppFolder, 1) <> "\" Then sAppFolder = sAppFolder & "\"
If UCase(sAppFolder) = UCase(Environ("OneDrive") & "\") Then
Call MsgBox("Sorry, this report folder has not yet" & vbCrLf & _
"fully synchronized from Sharepoint." & vbCrLf & _
"Please try again later.", vbOKOnly, "Error")
End
End If
End Sub
Programmcode ManageOnedriveSync
Der hier vorgestellte Code ist eine Erweiterung der unter (externer Link!) Stackoverflow gezeigten Version, damit man wichtige Eingabe- und Bearbeitungsdateien vor dem Abschalten von OneDrive synchronisieren kann.
Bitte beachten: Diese Subroutine benötigt das Modul (externer Link!) LibFileTools.
Bitte den Haftungsausschluss im Impressum beachten.
Ein Beispielaufruf:
Call ManageOnedriveSync(1, Array("Eingabedatei_1.csv", _
"Eingabedatei_2.xlsx", _
"Bearbeitungsdatei_1.xlsx"))
Selbstverständlich muss man vor dem Abschalten von OneDrive lediglich reine Eingabedateien synchronisieren sowie Dateien, die aktualisiert werden müssen. Für weniger versierte VBA Programmierer kann man listigerweise diesen Beispielaufruf fehlerhaft zur Verfügung stellen, damit sie aktiv darüber nachdenken, welche Dateien ihre VBA Anwendung unbedingt synchronisiert benötigt.
Sub ManageOnedriveSync(ByVal action As Integer, ParamArray touchpath() As Variant)
'Source: https://stackoverflow.com/questions/68099793/vba-start-stop-onedrive-sync-client
'Shutdown: ManageOnedriveSync 1
'Start: ManageOnedriveSync 0
'Requires LibFileTools: https://github.com/cristianbuse/VBA-FileTools
'Version When Who What
' 2 04-Mar-2025 Bernd Optional touchpath() will get synced before we switch off OneDrive sync
' 3 22-Jul-2025 Bernd Calling IsWorkbookOpen because input file might be open
' 4 19-Aug-2025 Bernd touchpath(i) can be an array or collection / variant
Dim bTest As Boolean
Dim waitTillComplete As Boolean
Dim bytInput As Byte
Dim errorcode As Integer
Dim FileNum As Integer
Dim i As Integer
Dim j As Integer
Dim style As Integer
Dim commandAction As String
Dim path As String
Dim shell As Object
waitTillComplete = False
style = 1
Set shell = VBA.CreateObject("WScript.Shell")
Select Case action
Case 1
If LBound(touchpath) <= UBound(touchpath) Then
'ParamArray is not empty
For i = LBound(touchpath) To UBound(touchpath)
If ArrayDim(touchpath(i)) > 0 Then
For j = LBound(touchpath(i)) To UBound(touchpath(i))
If Not IsWorkbookOpen(CStr(touchpath(i)(j))) Then
FileNum = FreeFile
Open touchpath(i)(j) For Input As #FileNum
bytInput = Asc(Input(1, #FileNum))
Close #FileNum
End If
Next j
ElseIf VarType(touchpath(i)) = vbVariant Or _
VarType(touchpath(i)) = vbObject Then
For j = 1 To touchpath(i).Count
If Not IsWorkbookOpen(CStr(touchpath(i)(j))) Then
FileNum = FreeFile
Open touchpath(i)(j) For Input As #FileNum
On Error Resume Next
bytInput = Asc(Input(1, #FileNum))
On Error GoTo 0
Close #FileNum
End If
Next j
Else
If Not IsWorkbookOpen(CStr(touchpath(i))) Then
FileNum = FreeFile
Open touchpath(i) For Input As #FileNum
On Error Resume Next
bytInput = Asc(Input(1, #FileNum))
On Error GoTo 0
Close #FileNum
End If
End If
Next i
End If
commandAction = "/shutdown"
End Select
path = Chr(34) & "C:\Program Files\Microsoft OneDrive\Onedrive.exe" & _
Chr(34) & " " & commandAction
errorcode = shell.Run(path, style, waitTillComplete)
End Sub
Function IsWorkbookOpen (fileName As String)
Dim ff As Long
Dim ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open fileName For Input Lock Read As #ff
Close ff
ErrNo = err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkbookOpen = False
Case 70: IsWorkbookOpen = True
Case Else: Error ErrNo
End Select
End Function