我如何判断一个宏是来自电子邮件还是来自 VBA 的桌面？运行？

Question

我开发宏已有很多年了。我们从本地驱动器使用运行这些宏。但是，由于营业额、新员工等原因，此信息并不总是传递给新用户。

我们有一个中心位置，供用户下载这些宏的副本。如果他们遵循程序，它会将宏保存到本地驱动器。但是，有时用户会通过电子邮件从同事那里获取宏。然后他们从电子邮件中打开或将它们保存到桌面。

如果他们运行来自电子邮件或桌面的宏，则可能存在问题；这通常需要有人联系我们寻求支持。我想尝试减少支持电话的数量。

我想知道是否有办法判断宏是从电子邮件还是从用户的桌面打开的。理想情况下，我正在考虑将代码添加到 "On Open" 模块并显示一条消息，告诉用户在打开/运行之前将宏保存到本地驱动器。

但是，我不确定如何识别这两个位置。我以前使用过 "Path" 属性，但这些宏可以位于数百个外地办事处的任意数量的驱动器上。我想如果我能识别电子邮件或桌面位置然后显示消息会更好。

我们的大多数用户都在使用 Office 2010 或 2016。感谢您的帮助.........

Answer 1

如果您从邮件中打开工作簿并进行调试 ThisWorkbook.Path，您将得到如下内容：

? thisworkbook.Path C:\Users\UserName\AppData\Local\Microsoft\Windows\INetCache\Content.OutlookPWSZZ9J

同样的事情会转到桌面，所以你可以使用Workbook_Open()触发器来检查工作簿路径，如果像Outlook或桌面发送一条消息警告将其保存在本地驱动器上。

根据 Shaves 评论进行编辑：

还有最后一种方法。假设他们的组策略允许他们将文件保存在本地 Dirve C:（假设他们都有那个驱动器）

你的方法可能是，

Option Explicit
Private Sub Workbook_Open()

    Dim DesiredFilePath As String, CurrentFilePath As String, wb As Workbook

    Set wb = ThisWorkbook

    DesiredFilePath = "C:\" & wb.Name
    CurrentFilePath = wb.Path & "\" & wb.Name

    If DesiredFilePath <> CurrentFilePath Then
        wb.SaveAs DesiredFilePath
        On Error Resume Next
        Kill CurrentFilePath
        On Error GoTo 0
        MsgBox "The file wasn't saved where it should be to work properly. It's been saved in: " & CurrentFilePath
    End If


End Sub

这样您不仅会警告用户，还会将文件保存在您需要的位置，然后从警告用户如何找到它的位置将其删除。

Answer 2

这是 Damian 建议的扩展版本。我将把它分成两部分。

第一部分：展望

我正在演示一个 MS Office 版本。欢迎向 Select Case

添加更多内容

当您在保存到硬盘驱动器之前打开电子邮件中的附件时，Outlook 会将副本放入 SecureTemp 文件夹中。此文件夹是 Internet 临时文件.

下的隐藏文件夹

Sub Sample()
    Dim ol_Version As String
    Dim ol_RegKey As String
    Dim ol_SecureTempRegKey As String
    Dim ol_SecureTempFolder As String

    '~~> This is the registry key which stores Outlook's version
    ol_RegKey = "HKEY_CLASSES_ROOT\Outlook.Application\CurVer\"

    ol_Version = CreateObject("WScript.Shell").RegRead(ol_RegKey)

    '~~> Check the outlook version
    Select Case ol_Version
        Case "Outlook.Application.15"

            ol_SecureTempRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office.0\Outlook\Security\OutlookSecureTempFolder"
        '
        '~~> Add more cases here
        '
    End Select

    If ol_SecureTempRegKey <> "" Then
        ol_SecureTempFolder = CreateObject("WScript.Shell").RegRead(ol_SecureTempRegKey)

        Debug.Print "Outlook's temp folder is " & ol_SecureTempFolder
    End If
End Sub

获得 SecureTemp 路径后，您可以检查文件是否从 Outlook 打开。

第二部分：从桌面

要获取用户的桌面文件夹路径，您可以使用它。获得 Desktop 路径后，您可以检查文件是否从那里打开。

Sub Sample()
    Dim desktopPath As String

    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

    Debug.Print "User's desktop folder is " & desktopPath
End Sub

我如何判断一个宏是来自电子邮件还是来自 VBA 的桌面？运行？

How can I tell if a macro is being run from an email or desktop with VBA?

email

excel

desktop

vba