MS Outlook

Sub sendmEAsAttachement()

Dim outApp As Outlook.Application
Dim nMail As Outlook.MailItem

Set outApp = Outlook.Application
Set nMail = outApp.CreateItem(olMailItem)


With nMail
'.Sender =
.Display
.Body = "Hello Team," & VBA.vbCrLf & VBA.vbCrLf & "jakiś tekst dla ludzików." & VBA.vbCrLf & VBA.vbCrLf & "Thank you." & VBA.vbCrLf & "Kindest regards," & .Body
'''' .SendUsingAccount = FindSNaccount(outApp) '' jeżeli chcę wysłać z innego konta outlook, to użyję tej komendy
.Attachments.Add ThisWorkbook.FullName ''dodaje ten plik jako załącznik, można użyć dowolną inną ścieżkę do pliku
.Subject = "temat"
.Recipients.Add "emil@domena.pl"
.CC = "jezelichękogośwcopy@toużywam.pl"
.Recipients.ResolveAll ''rozwiązuje kontakty w książce adresowej

End With
Set outApp = Nothing
Set nMail = Nothing

End Sub


Function FindSNaccount(outApp As Outlook.Application) As Outlook.Account
Dim outAcc As Outlook.Account
For Each outAcc In outApp.Session.Accounts
If outAcc.DisplayName Like "*excelwpracy*" Then
Set FindSNaccount = outAcc
Exit Function
End If
Next

Set FindSNaccount = outApp.Session.Accounts(1) '''jezeli nic nie znajdzie w kontach, to użyje pierwszego (główne w outlooku)

End Function


'pętla, która z danej ścieżki wrzuci wszystkie pliki o rozszerzeniu xlsx do załączników
StrFile = Dir(StrPath & "*.xlsx*")

Do While StrFile <> "" 'widziałem wersję: Do While Len(StrFile) > 0
.Attachments.Add StrPath & StrFile
StrFile = Dir
Loop

Sub sendemail(wbk As String, doo As String, ccc As String, subj As String, htmlbody As String, Optional pastesomething As String)

'opcjonalny pastesomething :) = jeżeli coś ma zostać wklejone do wiadomości, to jest kopiowane przed wywołaniem tej procedury
'wbk = ścieżka do załącznika
'doo, ccc to odbiorcy
'subj - temat, htmlbody to tekst maila
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next 'można zrobić sprawdzenie czy jest załącznik, np if wbk <>"" then .attachments.add wbk

With OutMail
.Display
'Stop
'' .SentOnBehalfOfName = "mail"
.To = doo
.cc = ccc
.Subject = subj
.body = htmlbody
.attachments.Add wbk
If Not pastesomething = "" Then
Dim wordDoc As Word.Document
Set wordDoc = OutMail.GetInspector.WordEditor

'wklejamy
wordDoc.Range.PasteAndFormat wdChartPicture
End If
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

nMail.to = OutApp.session.accounts.Item(1).DisplayName