如何(在VBA中)判断是否从SharePoint打开文档?

时间:2012-09-14 11:37:03

标签: sharepoint vba ms-office

有没有办法确定当前文档(无论是Word文档,Excel工作簿还是PowerPoint演示文稿)是否是从SharePoint服务器打开的?

你认为在ActiveDocument / ActiveWorkbook / ActivePresentation上会有一个属性,但是如果有这样的属性,我找不到它。

我可以查看FullName属性,看看它是否以http://开头,我认为这是一个合理的语言,但我确信必须有一个更清洁的方式。

如果它有所不同,我们假设使用Office 2007或更高版本(以及SharePoint 2007或更高版本)。

1 个答案:

答案 0 :(得分:1)

我前段时间遇到同样的问题,并没有找到干净的方法来确定这一点。我使用的脏方法是分析文档的原始路径并根据它确定源。它仍然有一两个陷阱,但应该处理非恶意的情况/用户。

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