しばらく前に同じ問題に直面しましたが、これを判断する明確な方法が見つかりませんでした。私が使用した汚い方法は、ドキュメントのオリジン パスを分析し、それに基づいてソースを特定することです。まだ 1 つまたは 2 つの落とし穴がありますが、悪意のない状況/ユーザーを処理する必要があります。
Private Sub Document_Open()
'if default drafts location is not set in registry then exit
If IsNull(GetDefaultDrafts()) Then Exit Sub
'if document path includes 'http://' then it comes from SharePoint
If InStr(ActiveDocument.Path, "http://") = 1 Then
'MsgBox ("Opened From SP")
Exit Sub
Else
'if it does not
If IsNull(GetCustomDrafts()) Then
'if there is no custom location for drafts in registry
'check if file path contains default location for drafts
'if it does then it most likely comes from SharePoint
If InStr(ActiveDocument.Path, GetDefaultDrafts()) = 1 Then
'MsgBox ("Opened From SP")
Exit Sub
Else
MsgBox WarningMessage(), vbCritical
Exit Sub
End If
Else
'there is custom location for drafts
If InStr(ActiveDocument.Path, GetCustomDrafts()) = 1 Then
'MsgBox ("Opened From SP")
Exit Sub
Else
MsgBox WarningMessage(), vbCritical
Exit Sub
End If
End If
End If
End Sub
Function GetDefaultDrafts()
Const HKEY_LOCAL_MACHINE = &H80000001
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
strValueName = "Personal"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
If IsNull(strValue) Then
GetDefaultDrafts = Null
Else
GetDefaultDrafts = strValue + "\SharePoint Drafts"
End If
End Function
Function GetCustomDrafts()
Const HKEY_LOCAL_MACHINE = &H80000001
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Office\Common\Offline\Options"
strValueName = "Location"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
If IsNull(strValue) Then
GetCustomDrafts = Null
Else
GetCustomDrafts = strValue
End If
End Function
Function WarningMessage()
WarningMessage = "It seems that this document has not been opened from SharePoint library but from local copy instead. Local copies must not be used to preserve system functionality."
End Function