Hi together,
I am newly into VBA and trying to learn it by doing.
What I want to do basically is sending different attachments to different persons via outlook.
I have written two different codes - just to try out and learn. One of it works, but it sends just the same things to different people:
'VBA Procedure to Prepare and Send Email
Sub SendEmail(S_UserName As String, S_EmailID As String)
'Declaring variables as object type to refer Outlook Application & Mail Item
Dim OutApp As Object ' Outlook Application
Dim OutMail As Object 'Outlook Mail Item
Dim sImgName As String
'Set the reference of Outlook Application
Set OutApp = CreateObject("Outlook.Application")
'Set the reference of Mail Item
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = S_EmailID
.From = "test@test.com"
.CC = "huhu.hello@test.com"
.BCC = ""
.Attachments.Add ThisWorkbook.Path & "\Rudolf.xlsx"
'Code to embed the image in mail body without using the original image source.
.Attachments.Add ThisWorkbook.Path & "\Test.png"
sImgName = "Test.png"
.Subject = "Aktion erforderlich "
.HTMLBody = "<HTML><Body><p style='font:11px Segoe UI'>Lieber " & "Händler" & ",<BR><BR> die Entfernung der entsprechenden Fahrzeuge veranlassen." _
& "<BR><BR> Wir wissen Deine Kooperation in dieser Angelegenheit sehr zu schätzen." & "<BR><BR> Wenn Du weitere Fragen haben oder Hilfe benötigen solltest, helfen wir sehr gerne weiter." & "<BR><BR>Mit freundlichen Grüßen," & ",<BR><BR> Dein xy-Team" & "<BR><BR> <img src='cid:" & sImgName & "'" & " ></a>"
'Set Font Size'
'.Display
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
'VBA Sub Procedure to Start Email
Sub Start_Email()
Dim iConfirmation As VbMsgBoxResult
iConfirmation = MsgBox("Do you want to send the emails?", vbYesNo + vbQuestion, "Confirmation")
If iConfirmation = vbNo Then Exit Sub
'Declaring Variables to refer the 'Email List' worksheet
Dim sh As Worksheet
Dim iRow As Integer
Set sh = ThisWorkbook.Sheets("Email List")
iRow = 2
Do While sh.Range("A" & iRow).Value <> ""
'check whether email has already sent or not
If sh.Range("C" & iRow).Value = "" Then
'Call SendEmail(S_UserName As String, S_EmailID As String)
Call SendEmail(sh.Range("A" & iRow).Value, sh.Range("B" & iRow).Value)
sh.Range("C" & iRow).Value = "Done"
End If
iRow = iRow + 1
Loop
End Sub
At the end of the day, I cant use it like that, since I have a lot other persons to send attachments to.
So I've written a different code:
Sub Send_Files()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the D:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Important"
.Body = "Hi " & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display/Send
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
On my Excel-File I have following Infos:
A: Name
B:Email
C:Attachement path
Whats the problem? The email comes, but without any attachement...What am I doing wrong? And is there any possibility, that I could use my first code with adding the second code? The reason I want to do this is, the first code I have created a ''Send'' button etc. which is nice, if you are working with people who dont know anything about excel..
Happy hearing your feedback!
I am newly into VBA and trying to learn it by doing.
What I want to do basically is sending different attachments to different persons via outlook.
I have written two different codes - just to try out and learn. One of it works, but it sends just the same things to different people:
'VBA Procedure to Prepare and Send Email
Sub SendEmail(S_UserName As String, S_EmailID As String)
'Declaring variables as object type to refer Outlook Application & Mail Item
Dim OutApp As Object ' Outlook Application
Dim OutMail As Object 'Outlook Mail Item
Dim sImgName As String
'Set the reference of Outlook Application
Set OutApp = CreateObject("Outlook.Application")
'Set the reference of Mail Item
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = S_EmailID
.From = "test@test.com"
.CC = "huhu.hello@test.com"
.BCC = ""
.Attachments.Add ThisWorkbook.Path & "\Rudolf.xlsx"
'Code to embed the image in mail body without using the original image source.
.Attachments.Add ThisWorkbook.Path & "\Test.png"
sImgName = "Test.png"
.Subject = "Aktion erforderlich "
.HTMLBody = "<HTML><Body><p style='font:11px Segoe UI'>Lieber " & "Händler" & ",<BR><BR> die Entfernung der entsprechenden Fahrzeuge veranlassen." _
& "<BR><BR> Wir wissen Deine Kooperation in dieser Angelegenheit sehr zu schätzen." & "<BR><BR> Wenn Du weitere Fragen haben oder Hilfe benötigen solltest, helfen wir sehr gerne weiter." & "<BR><BR>Mit freundlichen Grüßen," & ",<BR><BR> Dein xy-Team" & "<BR><BR> <img src='cid:" & sImgName & "'" & " ></a>"
'Set Font Size'
'.Display
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
'VBA Sub Procedure to Start Email
Sub Start_Email()
Dim iConfirmation As VbMsgBoxResult
iConfirmation = MsgBox("Do you want to send the emails?", vbYesNo + vbQuestion, "Confirmation")
If iConfirmation = vbNo Then Exit Sub
'Declaring Variables to refer the 'Email List' worksheet
Dim sh As Worksheet
Dim iRow As Integer
Set sh = ThisWorkbook.Sheets("Email List")
iRow = 2
Do While sh.Range("A" & iRow).Value <> ""
'check whether email has already sent or not
If sh.Range("C" & iRow).Value = "" Then
'Call SendEmail(S_UserName As String, S_EmailID As String)
Call SendEmail(sh.Range("A" & iRow).Value, sh.Range("B" & iRow).Value)
sh.Range("C" & iRow).Value = "Done"
End If
iRow = iRow + 1
Loop
End Sub
At the end of the day, I cant use it like that, since I have a lot other persons to send attachments to.
So I've written a different code:
Sub Send_Files()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the D:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Important"
.Body = "Hi " & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display/Send
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
On my Excel-File I have following Infos:
A: Name
B:Email
C:Attachement path
Whats the problem? The email comes, but without any attachement...What am I doing wrong? And is there any possibility, that I could use my first code with adding the second code? The reason I want to do this is, the first code I have created a ''Send'' button etc. which is nice, if you are working with people who dont know anything about excel..
Happy hearing your feedback!
