Frankietheflyer
New Member
- Joined
- Nov 17, 2017
- Messages
- 30
Hi
I have a code that runs through a list of people and sends individual files to each one. The code automatically sends the emails from one of two email accounts I have. Problem is, it's the account that isn't associated with the message!
I think there are probably two ways of doing this:
1.If there is more than one account when I start to run the code it asks me to type in the account address I want to send the emails from and uses that one.
2. The code automatically finds all the accounts I have in outlook (one's a "live.com.au" and the other is "y7mail.com") and lets me select the one I want to use.
It also needs to recognise if someone only has one email account and just carry on.
Anyone got a code that can do either of these?
My current code for sending the emails is as follows
Thanks everyone!
Frankie
I have a code that runs through a list of people and sends individual files to each one. The code automatically sends the emails from one of two email accounts I have. Problem is, it's the account that isn't associated with the message!
As this spreadsheet will be used by many different people I can't "hard wire" it to the correct account s
o I need to be able to select which account is used to send the email out under.I think there are probably two ways of doing this:
1.If there is more than one account when I start to run the code it asks me to type in the account address I want to send the emails from and uses that one.
2. The code automatically finds all the accounts I have in outlook (one's a "live.com.au" and the other is "y7mail.com") and lets me select the one I want to use.
It also needs to recognise if someone only has one email account and just carry on.
Anyone got a code that can do either of these?
My current code for sending the emails is as follows
Code:
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Sub MailSheets_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim File As Variant
Dim myFile As Variant, FolderName As String
Dim strPath As String, rngWB As Range, wsRO As Worksheet
[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] With Application
.EnableEvents = False
.ScreenUpdating = False
End With[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Set sh = Sheets("Contacts")[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Set OutApp = CreateObject("Outlook.Application")[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] 'Enter the path/file names in the C:C column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:C100")
File = ("C:\Users\" & Environ("USERNAME") & ("\Documents\PDF Completed Sheets for Team Captains ") & ThisWorkbook.Sheets("Running Order").Range("F1").Value & ("\") & cell.Offset(0, 1) & ".pdf")[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] With OutMail
.to = cell.Value
.Subject = cell.Offset(0, 4) & " Team Sheet"
.Body = "Hi " & cell.Offset(0, 2).Value & Chr(13) & Chr(13) & "Please find the Competed Team Sheet for " & cell.Offset(0, 4) & " attached." _
& Chr$(13) & Chr$(13) & "Trust you had fun!"[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] .Attachments.Add File
'.Display 'Or use
.Send
End With[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Set OutMail = Nothing
End If
Next cell[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]MsgBox "Emails have been sent"
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif][/FONT]Thanks everyone!
Frankie
