Swapping email accounts on send

[wmtsub]

Below is a snippet of the code I use to send emails from excel. I would like to expand this to change the sent from based on a list of vendors. So What I think is as the email is generating it would compare the field "VND" which is the vendors name against an excel spreadsheet and change the "BEHALF" to the corresponding email for the assigned account rep.

Do you think this can be done?

     Const Behalf = "wmtsubcontractors@cfm-us.com" ' <-- Name to send on behalf of  Exchange profile/account
    'Specify email recipients, subject, etc:
    .To = sal
    '.Cc = "carboncopy@..."
    .Subject = "- Past Due open Order Report for -   " & VND & "  ---  " & tdd
    .SentOnBehalfOfName = Behalf
    .Send '<-- Directly send out this email, use .Display instead for the debugging only

 

[DanteAmor]

Tyr this

     'Const Behalf = "wmtsubcontractors@cfm-us.com" ' <-- Name to send on behalf of  Exchange profile/account
     Set h = Sheets("Vendors")  'sheet name with vendors
     Set b = h.Columns("A").Find(VND, lookat:=xlWhole, LookIn:=xlValues)
     If Not b Is Nothing Then
        Behalf = h.Cells(b.Row, "B").Value
     Else
        Behalf = "wmtsubcontractors@cfm-us.com"
     End If
    'Specify email recipients, subject, etc:
    .To = sal
    '.Cc = "carboncopy@..."
    .Subject = "- Past Due open Order Report for -   " & VND & "  ---  " & tdd
    .SentOnBehalfOfName = Behalf
    .Send '<-- Directly send out this email, use .Display instead for the debugging only

 

[wmtsub]

Thanks for the quick response. I cannot ge ti to work. I think it is becuase the vendor sheet is interfering with the workbook. I would actually prefer it to be a stand alone workbook. Can we do that?

 

[DanteAmor]

Test:

   'Const Behalf = "wmtsubcontractors@cfm-us.com" ' <-- Name to send on behalf of  Exchange profile/account
     set l = workbooks("book vendors.xlsx")   'open book name with vendors
     Set h = l.Sheets("Vendors")  'sheet name with vendors
     Set b = h.Columns("A").Find(VND, lookat:=xlWhole, LookIn:=xlValues)
     If Not b Is Nothing Then
        Behalf = h.Cells(b.Row, "B").Value
     Else
        Behalf = "wmtsubcontractors@cfm-us.com"
     End If
    'Specify email recipients, subject, etc:
    .To = sal
    '.Cc = "carboncopy@..."
    .Subject = "- Past Due open Order Report for -   " & VND & "  ---  " & tdd
    .SentOnBehalfOfName = Behalf
    .Send '<-- Directly send out this email, use .Display instead for the debugging only

 

[wmtsub]

Thank you for the help. Just getting back to this now. The message boxes return the correct info but I can not seem to get the email to send on be half correctly. I did have to modify the code a bit to work so here is what I am using:

 Set l = Workbooks.Open("\\JAX2-FILE-01\Procurement\..  M A N A G E D  C O N T R A C T S\EDS\Account Representitive.xlsm")   'open book name with vendors
     Set h = Sheets("VENDORS")  'sheet name with vendors
     Set b = Columns("a").Find(vnd, lookat:=xlWhole, LookIn:=xlValues)
      
      
      If Not b Is Nothing Then
      Behalf = Cells(b.Row, "B").Value
      Else
      Behalf = "wmtsubcontractors@cfm-us.com"
      End If
MsgBox vnd
MsgBox b
MsgBox Behalf
   
    
    'Specify email recipients, subject, etc:
    .To = sal
    '.Cc = "carboncopy@..."
    .Subject = "- Past Due open Order Report for -   " & vnd & "  ---  " & tdd
    .SentOnBehalfOfName = Behalf
    
  '  .send '<-- Directly send out this email, use .Display instead for the debugging only
    .display
   
  End With

 

[DanteAmor]

While it works, it's fine
I'm glad to help you