VBA根据主题行附加pdf答案

【问题标题】：VBA attach pdf based on subject lineVBA根据主题行附加pdf
【发布时间】：2020-06-26 06:45:59
【问题描述】：

更新##

这是迄今为止我从建议中得到的。我迷路了……

Sub Attach()
    Set objOutlookMgs = Application.ActiveInspector.CurrentItem
    Dim Subject As String
    Subject = Dir("H:\Contracts\Alphabetical\")
    Do While Len(Subject) > 0
        Attachments.Add Subject
        Subject = Dir
    Loop
End Sub

原帖

在我的工作中，我们有保存为 pdf 的合同。我们将这些通过库存电子邮件模板发送给人们，其中唯一改变的是主题行和附件。主题行与我要附加的文件名相同。

我想为 Outlook 创建一个宏，它使用主题行来查找并附加存储在共享驱动器中的文件。

文件路径为 H:\Contracts\Alphabetical\x x 表示字母 a-z，它们是包含根据主题行的第一个字母存储的文件的子文件夹。

我有一个我们使用的模板，它有一个固定的主体。在模板中输入主题行后，我希望能够运行宏。主题行遵循这种格式

“帐户 - 参考 - 日期”

格式类似于 CompanyName - 12345675 - 23OCT2014。

有没有办法让宏搜索具有该名称的文件并自动附加它。我可以通过每次附加一个设置文件来解决问题，但要搜索一个我不知道的文件。

【问题讨论】：

标签： vba outlook

【解决方案1】：

您不需要搜索文件，因为您知道文件夹和文件名

我认为这应该可行：

With objOutlookMsg 
           .Attachments.Add "H:\Contracts\Alphabetical\" & mid(objOutlookMsg.Subject, 1, 1) & "\" &  objOutlookMsg.Subject & ".pdf" '(leave the pdf-part away if this is in the subject-line)
End With

我希望这行得通，最大

【讨论】：

如果你敢这样做，你可以在所有那些“X”文件夹中搜索新的 pdf（检查已经发送的数据库或刚刚发送的更新日期......）并创建所有邮件自动...
如何运行这段代码？在我打开模板时插入一个模块并运行它似乎不起作用？
如果您没有，可能设置 objOutlookMgs = Application.activeinspector.currentitem。但建议的方法要求主题与文件名匹配。

【解决方案2】：

尝试这样的事情，使用 Dir

Loop through files in a folder using VBA?

要点，不工作的代码。

Set objOutlookMsg = application.activeinspector.currentitem

strFolder= "H:\Contracts\Alphabetical\" & left(objOutlookMsg.Subject, 1) & "\"
file = Dir(strFolder & "*.pdf")
   While (file <> "")
      debug.print "found " & file
      Exit Sub ' Assumes there is only one pdf otherwise remove this
    file = Dir
  Wend

您需要添加附件，而不是 debug.print。

编辑 2015 02 16

所以我知道这个复杂的想法是可行的。 Max 的回答要好很多。

Private Sub Loop_SearchForPdf()

    Dim strPath As String
    Dim strFile As String
    Dim leftstrFile As String

    Dim x As Integer

    Dim objOutlookMsg As mailitem
    Set objOutlookMsg = Application.ActiveInspector.currentItem
    objOutlookMsg.Save  ' To save the newly entered subject

    strPath = "H:\Contracts\Alphabetical\" & Left(objOutlookMsg.Subject, 1) & "\"
    Debug.Print strPath

    strFile = Dir(strPath)

    Do While strFile <> ""
        x = x + 1

        Debug.Print "x = " & x & "         strfile: " & strFile
        leftstrFile = Left(strFile, Len(strFile) - 4)
        Debug.Print "          leftstrfile: " & strFile
        Debug.Print "objOutlookMsg.Subject: " & objOutlookMsg.Subject

        If leftstrFile = objOutlookMsg.Subject Then
            objOutlookMsg.Attachments.Add strPath & strFile, , 1
            Exit Do
        End If

        strFile = Dir    ' Get next entry.
    Loop

End Sub

编辑 2015 02 16 结束

【讨论】：