Consulting

Results 1 to 4 of 4

Thread: Send individual PDF's with contact list in Excel - Specify "From" in a cell

  1. #1

    Send individual PDF's with contact list in Excel - Specify "From" in a cell

    HI,

    I tried to send some PDF with contact list in Excel. I found a code on internet and try to change it a little bit. I'm new with VBA and I'm learning by myself
    I would like to change the Email of the person sending the Email.
    I'd like The Email address is based on a specific cell. To put a specific Email address so It'll be accessible for users with no understanding at all with VBA.

    I tried to add : outlookmailitem.From = [COLOR=var(--black-750)]Dir[/COLOR][COLOR=var(--black-750)]([/COLOR][COLOR=var(--black-750)]Range[/COLOR][COLOR=var(--black-750)]([/COLOR][COLOR=var(--red-800)]"K9"[/COLOR][COLOR=var(--black-750)]).[/COLOR][COLOR=var(--black-750)]Value[/COLOR][COLOR=var(--black-750)]) in the code but it doesn't work...
    Everything is working Is a I delete this line but I'm the sender and I don't want that.

    [/COLOR]Can you help me please.
    Thanks a lot

    Sub Send_email_fromexcel()
    Dim Email_Address_1 As String
    Dim Subject As String
    Dim Email_Address_2 As String
    Dim CC As String
    Dim message As String
    Dim filename As String
    Dim outlookapp As Object
    Dim outlookmailitem As Object
    Dim myAttachments As Object
    Dim Path As String
    Dim lastrow As Integer
    Dim Attachment As String
    Dim x As Integer


    x = 2


    Do While Sheet1.Cells(x, 1) <> ""

    Set outlookapp = CreateObject("Outlook.Application")
    Set outlookmailitem = outlookapp.CreateItem(0)
    Set myAttachments = outlookmailitem.Attachments
    Path = "PATH"
    Email_Address_1 = Sheet1.Cells(x, 1)
    Email_Address_2 = Sheet1.Cells(x, 2)
    CC = Sheet1.Cells(x, 3)
    Subject = Sheet1.Cells(x, 4)
    filename = Sheet1.Cells(x, 6)
    Attachment = Path + filename



    outlookmailitem.From = [COLOR=var(--black-750)]Dir[/COLOR][COLOR=var(--black-750)]([/COLOR][COLOR=var(--black-750)]Range[/COLOR][COLOR=var(--black-750)]([/COLOR][COLOR=var(--red-800)]"K9"[/COLOR][COLOR=var(--black-750)]).[/COLOR][COLOR=var(--black-750)]Value[/COLOR][COLOR=var(--black-750)])[/COLOR]
    outlookmailitem.To = Email_Address_1
    outlookmailitem.CC = Email_Address_2
    outlookmailitem.BCC = CC
    outlookmailitem.Subject = Subject
    outlookmailitem.Body = "TEXT"


    myAttachments.Add (Attachment)
    outlookmailitem.Display
    outlookmailitem.send

    lastrow = lastrow + 1
    Email_Address_1 = ""
    x = x + 1


    Loop




    Set outlookapp = Nothing
    Set outlookmailitem = Nothing




    MsgBox "All the documents have been sent"


    End Sub

  2. #2
    You cannot simply change the sender address. You can either change the sending account, which will change the sender to that account or you can send on behalf of someone. I have no idea what your text in bold is supposed to do.

    https://www.gmayor.com/email_merge_addin.html will facilitate merging from Excel to e-mail and allow you to add PDF attachments identified in the data source.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    You'll find below the VBA code without the bold :


    Sub Send_email_fromexcel()
    Dim Email_Address_1 As String
    Dim Subject As String
    Dim Email_Address_2 As String
    Dim CC As String
    Dim message As String
    Dim filename As String
    Dim outlookapp As Object
    Dim outlookmailitem As Object
    Dim myAttachments As Object
    Dim Path As String
    Dim lastrow As Integer
    Dim Attachment As String
    Dim x As Integer




    x = 2


    Do While Sheet1.Cells(x, 1) <> ""

    Set outlookapp = CreateObject("Outlook.Application")
    Set outlookmailitem = outlookapp.CreateItem(0)
    Set myAttachments = outlookmailitem.Attachments
    Path = "PATH"
    Email_Address_1 = Sheet1.Cells(x, 1)
    Email_Address_2 = Sheet1.Cells(x, 2)
    CC = Sheet1.Cells(x, 3)
    Subject = Sheet1.Cells(x, 4)
    filename = Sheet1.Cells(x, 6)
    Attachment = Path + filename



    outlookmailitem.To = Email_Address_1
    outlookmailitem.CC = Email_Address_2
    outlookmailitem.BCC = CC
    outlookmailitem.Subject = Subject
    outlookmailitem.Body = "Please find your account Statement" & vbCrLf & vbCrLf & "Best Regards "


    myAttachments.Add (Attachment)
    outlookmailitem.Display
    outlookmailitem.send

    lastrow = lastrow + 1
    Email_Address_1 = ""
    x = x + 1


    Loop




    Set outlookapp = Nothing
    Set outlookmailitem = Nothing




    MsgBox "All the documents have been sent"


    End Sub

    How can I change the sending account?

    Thanks for your help

  4. #4
    You need something like

    Sub Send_email_fromexcel()
    Dim Email_Address_1 As String
    Dim Subject As String
    Dim Email_Address_2 As String
    Dim CC As String
    Dim message As String
    Dim filename As String
    Dim outlookapp As Object
    Dim oAccount As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
    Dim outlookmailitem As Object
    Dim Path As String
    Dim lastrow As Integer
    Dim Attachment As String
    Dim x As Integer
    Dim bAcc As Boolean
    Const sAcc As String = "someone@somewhere.com"    'Displayname of account to use
    
        x = 2
    
        'it would be better to use the code from 'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
        'to start Outlook
        Set outlookapp = CreateObject("Outlook.Application")    'before the loop!
    
        'Check the available accounts for the required account.
        For Each oAccount In outlookapp.Session.Accounts
            If oAccount.DisplayName = sAcc Then
                bAcc = True
                Exit For
            End If
        Next
        'Set action if account is not found
        If Not bAcc = True Then
            MsgBox "The account " & sAcc & " was not found." & vbCr & "Messages will be sent using the default account"
        End If
    
        Do While Sheet1.Cells(x, 1) <> ""
            Path = "PATH"    'Where does this come from? - Don't forget the path separator!
            Email_Address_1 = Sheet1.Cells(x, 1)
            Email_Address_2 = Sheet1.Cells(x, 2)
            CC = Sheet1.Cells(x, 3)
            Subject = Sheet1.Cells(x, 4)
            filename = Sheet1.Cells(x, 6)
            Attachment = Path & filename
    
            Set outlookmailitem = outlookapp.CreateItem(0)
            With outlookmailitem
                If bAcc = True Then .SendUsingAccount = oAccount
                .To = Email_Address_1
                .CC = Email_Address_2
                .BCC = CC
                .Subject = Subject
                .BodyFormat = 2    'html
                .Attachments.Add Attachment
    
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range
                oRng.Collapse 1
    
                oRng.Text = "Please find your account Statement" & vbCrLf & vbCrLf & "Best Regards "
                .Display
                .Send
            End With
    
            lastrow = lastrow + 1
            Email_Address_1 = ""
            x = x + 1
        Loop
    
        Set outlookapp = Nothing
        Set outlookmailitem = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Set oAccount = Nothing
    
        MsgBox "All the documents have been sent"
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •