0

Update##

This is what i have got from the suggestions so far. Im lost as all hell...

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

Original Post

At my work we have contracts saved as pdf's. We send these to people in a stock email template in which the only thing that changes is the subject line and the attachment. The subject line is the same as the file name I am looking to attach.

I would like to create a macro for outlook that uses the subject line to find and attach the file stored in a shared drive.

The file path is H:\Contracts\Alphabetical\x x signifies letters a-z which are sub folders which contain the files stored based on the first letter of the subject line.

I have a template we use that has a fixed body. I would like to be able to run the macro once i have entered the subject line in the template. The Subject line follows this format

"Account - ref - DATE"

Format would be something like CompanyName - 12345675 - 23OCT2014.

Is there a way of having the macro search for a file with that name and attach it automatically. I can work my way through attaching a set file each time but searching for one i have no idea about.

Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343

2 Answers2

0

you do not need to make a search for the file, as you know the Folder and file-Name

I think this should work:

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

I hope this works, Max

Max
  • 744
  • 1
  • 7
  • 19
  • if you dare to go that way you could search all those "X"-Folders for new pdf's (either checking against a database which have been sent already or just by date newer then..) and create all the mails automatically... – Max Oct 23 '14 at 13:44
  • How do i run this code? inserting a module and running it when i have the template open does not seem to work? – Andrew Woodcock Oct 23 '14 at 15:30
  • Possibly Set objOutlookMgs = Application.activeinspector.currentitem if you did not have it. but the suggested method requires the subject to match the name of the file. – niton Oct 25 '14 at 15:02
0

Try something like this, using Dir

Loop through files in a folder using VBA?

The main points, not working code.

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

Instead of debug.print you will want to add attachments.

Edit 2015 02 16

So I know this convoluted idea could work. Max's answer is a lot better.

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

Edit 2015 02 16 end

Community
  • 1
  • 1
niton
  • 8,771
  • 21
  • 32
  • 52