Question

我需要构建一个规则脚本，将Outlook附件（特定于Excel）保存到用户的硬盘驱动器中。然后，我需要为此excel附件添加密码，然后转发它。

使用VBA Outlook开发人员工具（见下文）保存和转发电子邮件/附件非常简单。但是，我遇到了向此附件添加密码的问题。这是可能的还是我需要一个外部脚本/程序来完成这项任务？此外，您还有其他建议吗？

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim saveFolder As String
    saveFolder = "c:\"
     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          Set objAtt = Nothing
     Next
     Call SendEmail
End Sub

Public Sub SendEmail()

    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim blRunning As Boolean

     'get application
    blRunning = True
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = New Outlook.Application
        blRunning = False
    End If
    On Error GoTo 0

    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
        .Subject = "My email with attachment"
        .Recipients.Add "jlanz@mmyemail.com"
        .Attachments.Add "C:\test123.xlsx"
        .Body = "Here is an email"
        .Send 
    End With
If Not blRunning Then olApp.Quit

Set olApp = Nothing
    Set olMail = Nothing

End Sub

Answer 1

根据我的评论，您需要添加对excel库的引用。然后，您可以使用以下示例设置密码。

Sub ProtectExcelWorkbook(filePath As String)
Dim pw As String
pw = "password"

    Dim eApp As Excel.Application
    Dim eBook As Excel.Workbook
    Set eApp = New Excel.Application
    Set eBook = eApp.Workbooks.Open(filePath)    
    eBook.Password = pw
    eBook.Save

    Set eBook = Nothing
    eApp.Quit
    Set eApp = Nothing

End Sub


Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim saveFolder As String
    saveFolder = "c:\"
     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          ProtectExcelWorkbook saveFolder & "\" & objAtt.DisplayName
          Set objAtt = Nothing
     Next
     Call SendEmail
End Sub

使用密码保存Outlook Attachement然后转发

1 个答案: