1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Attachment based on cell value in a excel email macro

Discussion in 'Business Applications' started by toofani, Dec 30, 2014.

Thread Status:
Not open for further replies.
  1. toofani

    toofani Thread Starter

    Joined:
    Jun 15, 2012
    Messages:
    36
    Hy guys

    2nd time i am posting stuff for help, and as i was helped before i will again look forward the response.

    I have a file of excel, in which i am sending emails to different candidates of admission, with scan letter placed in the same folder by name.

    I want to edit this code, which could select attachment based on Column A list adjacent to the email address

    I am attaching the file also pasting the code



    Sub Test1()
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    'Working in Office 2000-2013
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
    LCase(Cells(cell.Row, "C").Value) = "yes" Then

    Set OutMail = OutApp.CreateItem(0)

    strbody = "We at Graduate School of Engineering Sciences and Information Technology are extremely pleased to know that you have selected Hamdard University as preferred choice for your graduate/post-graduate Studies. " & vbNewLine & vbNewLine & _
    "Hamdard University is a pioneer Higher Education Institute (HEI) of Karachi producing Masters and PhDs in the fields of Engineering, Computer Sciences, Information Technology, Energy and Environment since 1997. " & vbNewLine & vbNewLine & _
    "Graduate School of Engineering Sciences and Information Technology (GSESIT) at the Faculty of Engineering Sciences and Technology (FEST), Hamdard University (HU), prepares students to meet the challenges of contemporary world with confidence and success, carry out research in most demanding domains and enables the students to develop a level of knowledge and expertise that allows them to practice independently or collaboratively at advanced level in their field of choice. Our academic programs emphasize student/faculty interaction and timely completion of the degree. We take pride in offering quality education at affordable cost and strong service to our students. " & vbNewLine & vbNewLine & _
    "Attached here you will find 'A Brief Guide for Prospective GSESIT Students' that will facilitate you in knowing more about Graduate School of Engineering Sciences & Information Technology and its degree program offerings. " & vbNewLine & vbNewLine & _
    "Your positive response to this e-mail would trigger our Student Care Management team to take personal care to see you through a seamless joining at Graduate School of Engineering Sciences & Information Technology for a degree program of your choice. " & vbNewLine & vbNewLine & _
    "We would like to be with you all the way…. and wish you the best in your academic pursuits. " & vbNewLine & vbNewLine & _
    "Keep connected to GSESIT via www.facebook.com/gsesit and www.twitter.com/gsesit or send a message from your mobile containing text " & vbNewLine & vbNewLine & _
    "follow @gsesit " & vbNewLine & vbNewLine & _
    "to 40404 " & vbNewLine & vbNewLine & _
    "for receiving updates about programs held at GSESIT. " & vbNewLine & vbNewLine & _
    "For any further information feel free to contact me. "

    SigString = Environ("appdata") & _
    "\Microsoft\Signatures\Babar.txt"

    If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
    Else
    Signature = ""
    End If
    On Error Resume Next
    With OutMail
    .To = cell.Value
    .Subject = "Admission at Hamdard University"
    .CC = "[email protected]; [email protected]"
    .Body = strbody & vbNewLine & Signature
    'You can add files also like this
    .Attachments.Add ("C:\Users\Babar\Desktop\admissions\Brief Guide for Prospective GSESIT Students.pdf")
    '.Send 'Or use Display
    .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    End If
    Next cell

    cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    End Sub

    Function GetBoiler(ByVal sFile As String) As String
    'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
    End Function
     

    Attached Files:

    • ad.xlsm
      File size:
      22.3 KB
      Views:
      33
  2. toofani

    toofani Thread Starter

    Joined:
    Jun 15, 2012
    Messages:
    36
    anybody ???
     
  3. draceplace

    draceplace

    Joined:
    Jun 8, 2001
    Messages:
    2,583
    Add the logic like this
    AttachPath = "C:\My_Attachments\"
    AttachDoc = AttachPath & Cell(A.value) & ".pdf"

    With OutMail
    .Attachment.Add (AttachDoc)
    End with

    I'm not an excel macro writer (I do know vba) so not sure of the exact syntax to reference the value of column A but basically you build the path to the document with that value.
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1140206

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice