Outlook重新启动后未运行Visual Basic

时间:2015-07-24 18:26:07

标签: vba outlook outlook-vba

所以我在outlook中创建了一个visual basic脚本,它通过从Git中提取来创建一个随机签名。

脚本正常工作,但每当我重新启动计算机时,脚本根本不会运行。

我通过转到

解决了这个问题
"File"->"Options"->"Trust Center"->"Trust Center Settings..."->"Macro Settings"->"Enable all macros"

每当我打开和关闭Outlook时,这都让VBA代码工作,但是当我重新打开Outlook或重新启动我的机器时,有更好的方法让代码工作。

我尝试过使用

Private Sub Application_Startup() 

    MsgBox "Hi"

End Sub

虽然当我第一次插入代码时该代码确实有效,但每当我重新启动outlook时它都说它无法运行因为“宏被禁用”

以下是我的随机签名代码,无论如何,每当我重新启动outlook或我的机器时都能使用它?或者我编辑的宏设置是否正确?

Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

' Validate that the item sent is an email.
    If Item.Class <> olMail Then Exit Sub

'These first variables is to find the file the .bat file created within the AppData folder
'Set enviro to %APPDATA%
    Dim enviro As String
    enviro = CStr(Environ("APPDATA"))
'Create a new variable that sets the file path for the RepoDir.txt
    RepoPath = enviro & "\RepoDir.txt"

'Create a new variable to grab the line of text in RepoDir.txt
    Dim RepoFilePath As String
    Dim strFirstLine As String

'The new variable calls the RepoPath Variable, opens it and reads the first line of the file and copies it into a variable
    RepoFilePath = RepoPath
    Open RepoFilePath For Input As #1
    Line Input #1, strFirstLine
    Close #1

'The script runs a Shell command that opens the command line, cds to the Repo path within the str variable, does a git pull, and outputs the error level to a file in the temp directory
    Shell ("cmd /c cd " & strFirstLine & " & git pull RandomSig & echo %ERRORLEVEL% > %TEMP%\gitPull.txt 2>&1")

'These second set of variables is to find the file the Shell command created within the TEMP folder
'Set enviro to %TEMP%
    Dim Gitenviro As String
    Gitenviro = CStr(Environ("TEMP"))
'Create a new variable that sets the file path for the RepoDir.txt
    PullResult = Gitenviro & "\gitPull.txt"

'Create a new variable to grab the line of text in RepoDir.txt
    Dim GitFilePath As String
    Dim GitFirstLine As String

'The new variable calls the PullResult Variable, opens it and reads the first line of the file and copies it into a variable
    GitFilePath = PullResult
    Open GitFilePath For Input As #2
    Line Input #2, GitFirstLine
    Close #2
    'MsgBox (GitFirstLine)

'The variable is checked to see if it does not equal 0, and if it doesn't the message is cancelled
    If GitFirstLine <> 0 Then
        MsgBox "There was an error when attempting to do the Git Pull, cancelling message"
        Cancel = True
    End If

    Const SearchString = "%Random_Line%"
    Dim QuotesFile As String

    QuotesFile = strFirstLine & "quotes.txt"


    If InStr(Item.Body, SearchString) Then
        If FileOrDirExists(QuotesFile) = False Then
            MsgBox ("Quotes file wasn't found! Canceling message")
            Cancel = True
        Else
            Dim lines() As String
            Dim numLines As Integer
            numLines = 0

        ' Open the file for reading
            Open QuotesFile For Input As #1

        ' Go over each line in the file and save it in the array + count it
            Do Until EOF(1)
                ReDim Preserve lines(numLines + 1)
                Line Input #1, lines(numLines)
                numLines = numLines + 1
            Loop

            Close #1

        ' Get the random line number
            Dim randLine As Integer
            randLine = Int(numLines * Rnd()) + 1

        ' Insert the random quote
            Item.HTMLBody = Replace(Item.HTMLBody, SearchString, lines(randLine))
            Item.HTMLBody = Replace(Item.HTMLBody, "%Random_Num%", randLine)
        End If
    End If
    End Sub

    Function FileOrDirExists(PathName As String)
    Dim iTemp As Integer

    On Error Resume Next
    iTemp = GetAttr(PathName)

    Select Case Err.Number
    Case Is = 0
        FileOrDirExists = True
    Case Else
        FileOrDirExists = False
    End Select

    On Error GoTo 0
End Function

1 个答案:

答案 0 :(得分:2)

强烈建议您将宏安全设置保留为仅允许self-sign certificate

  

请勿使用“低”选项或全部运行

创建自签名证书

  1. 转到开始&gt; 所有程序&gt; Microsoft Office &gt; Microsoft Office工具,然后单击“数字证书”。 VBA项目。

  2. 在您的证书名称框中,输入证书的名称。

  3. 单击“确定”。然后会出现SelfCert Success消息,单击OK。

  4. enter image description here

    1. 转到“开发人员”选项卡&gt; 单击“Visual Basic”。或 ALT + F11

    2. 在Visual Basic编辑器中,转到工具&gt; 数字签名。

    3. 出现数字签名对话框并单击选择,您将看到一个选择证书的屏幕。现在您可以选择刚刚创建的证书。

    4. 修改

      找到SelfCert.exe

      转到“开始”菜单,输入 VBA 会显示SelfCert.exe

      enter image description here

      查找SelfCert.exe

      的替代方法

      如果您在“开始”菜单中找不到它?然后默认情况下,您可以在以下位置找到SelfCert.exe

      Windows 32位

      C:\Program Files\Microsoft Office\Office <version number>

      Windows 64位,Office 32位

      C:\Program Files (x86)\Microsoft Office\Office <version number>

      Windows 64位,带有Office 64位

      C:\Program Files\Microsoft Office\Office <version number>

      Office 365(Office 2013的基于订阅或即点即用版本)

      C:\Program Files\Microsoft Office 15\root\office15

      如果未安装SelfCert.exe

      然后运行Office安装程序并选择Add or Remove Features

      对于旧版本的Office,您需要选择Custom installation,然后选择Advanced customization

      展开Office Shared Features部分,然后选择Digital Certificate for VBA Projects从您的计算机上运行。

      找到它后,只需运行SelfCert.exe