Question

更新##

这是我从目前为止的建议中得到的。我完全失去了......

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＆＃39; s。我们将这些发送给股票电子邮件模板中的人，其中唯一改变的是主题行和附件。主题行与我要附加的文件名相同。

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

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

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

＆＃34;帐户 - 参考 - 日期＆＃34;

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

是否有办法让宏搜索具有该名称的文件并自动附加。我可以通过每次附加一个设置文件来工作，但是搜索一个我不知道的文件。

Answer 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

我希望这有效，最大

Answer 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

所以我知道这个错综复杂的想法可行。马克斯的答案要好得多。

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结束

VBA根据主题行附加pdf

更新##

原帖

2 个答案: