Workbook attachement with correct email address

[hanz753]

Hello I need help with a VBA code.

I am currently using the below code to save files to the correct folders.

Sub Button1_Click()

Dim Path As String
Dim filename As String
Dim filename2 As String
Dim country As String
Dim Fixpath As String

filename = Range("J3")
filename2 = Range("J4")
country = Range("J5")
Fixedpath = "L:\FINANCE\Aug 18"

If country = "GB" Then
Path = "UK"
ElseIf country = "DE" Then
Path = "CE"
ElseIf country = "FS" Then
Path = "FR"
ElseIf country = "NO" Then
Path = "Nordics"
ElseIf country = "SE" Then
Path = "Nordics"
End If



ActiveWorkbook.SaveAs filename:=Fixedpath & Path & filename & filename2 & ".xls", FileFormat:=xlNormal


End Sub


The next step would be to attach workbook to an email addressing a company based on the company code.

Company code: FR
Email Addressed to: Query@Francetech.com

Can this be done or would I need to create a separat macro.

Kind Regards
Hanz

 

[daverunt]

Have a look here.
https://www.rondebruin.nl/win/s1/outlook/amail1.htm

The first bit of code should do what you want. You can use the code as a continuation of your own macro.

 

[hanz753]

Hello,

Thank you for emailig me the link very helpful.

I am using the below code and it seems to be working.

Sub Button2_Click()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "Hanz@DS.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

I need to include an IF function E.g.

If the Company Code in the active worksheet is GB the send to UK@DS.com
If Company code is DS then send to Germany@DS.com
"" SE then send to sweden@DS.com

Thank you

 

[daverunt]

Hi,

I would use Select Case. Add as many Case Is lines as you need. The case else is for unrecognised codes an prompts for an email address.
I have added "J5" from the example in the first post as the location of the country code.

Sub Button2_Click()
 'Working in Excel 2000-2016
 'This example send the last saved version of the Activeworkbook
 'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
 Dim OutApp As Object
 Dim OutMail As Object
 Set OutApp = CreateObject("Outlook.Application")
 Set OutMail = OutApp.CreateItem(0)
 
 
 Select Case Range("J5").Value
 
 Case Is = "DS"
 EmailTo = "germany@DS.com"
 
 Case Is = "GB"
 EmailTo = "UK@DS.com"
 
 Case Is = "SE"
 EmailTo = "sweden@DS.com"
 
 Case Else
 EmailTo = InputBox("Enter Email Address")
 End Select
 
 
 On Error Resume Next
 With OutMail
 .to = EmailTo
 .CC = ""
 .BCC = ""
 .Subject = "This is the Subject line"
 .Body = "Hi there"
 .Attachments.Add ActiveWorkbook.FullName
 'You can add other files also like this
 '.Attachments.Add ("C:\test.txt")
 .Send 'or use .Display
 End With
 On Error GoTo 0
 Set OutMail = Nothing
 Set OutApp = Nothing
End Sub

If the email macro is a continuation of your save macro you can use

If country = "GB" Then
 Path = "UK"
EmailTo=UK@DS.com
Else If
etc.....


and in the mail section

.to = EmailTo

 

[hanz753]

Works perfectly. Thank you!

 

[daverunt]

Great. Thanks for the feedback.

 

[hanz753]

Hello,

Just one more thing regarding the coding,

If I was to adjust the code so that outlook opens with the Attachment and correct CC email address. This is so additional text maybe needed in the body of the email.

Thank you for your help.

I am using the below code.

Sub Button2_Click()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


Select Case Range("J5").Value

Case Is = "DS"
EmailTo = "SSCCEJVProcessing@pb.com"

Case Is = "GB"
EmailTo = "SSC-Journal-Processing@pb.com"

Case Is = "SE"
EmailTo = "SSCNDSJVProcessing@pb.com"

Case Is = "NO"
EmailTo = "SSCNDSJVProcessing@pb.com"

Case Is = "CH"
EmailTo = "SSCCEJVProcessing@pb.com"

Case Is = "FI"
EmailTo = "SSCNDSJVProcessing@pb.com"

Case Else
EmailTo = InputBox("Enter Email Address")
End Select


On Error Resume Next
With OutMail
.to = EmailTo
.CC = "sylwia.cwik@pb.com"
.BCC = ""
.Subject = Range("J6").Value
.Body = "Hi there please post the attacehd journal Kind Regards Hanif"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Thank you
Hanz

 

[daverunt]

If you want to validate the mail content prior to manually pressing the send button just change:

.Send to .Display

Additional text can be added.
It doesn't have to be .body="mail info"
It can be a mix and match of code from cell content, variable strings or input boxes as required.

In this case you could put a different mail body in each select case:

Case Is = "DS"
 EmailTo = "SSCCEJVProcessing@pb.com"
MailBody="Hi Fred," & vbNewLine & vbNewLine & "Here is your report" & vbNewLine & "Best Regards & vbNewLine & "Hanz"

.Body = MailBody