Hallo Zusammen,

es geht darum automatische Emails aus Excel zu erstellen, welche Verschlüsselt sein sollen. Hier scheitert es leider mit meinem geringen VBA-Kenntnissen, da ich zwar schon in verschiedenen Foren gegoogelt habe, aber die Kommandos für die Schaltfläche über den Inspektor nicht verstehe ... 

Ich hoffe es kann mir jmd weiterhelfen, da ich echt langsam verzweifele. Vielen Dank im Voraus! 

  Sub cmdSend_Click() Dim OutApp As Outlook.Application Dim OutAccount As Outlook.Account Dim OutMail As Outlook.MailItem Dim cell As Range Dim txtSubj, strText, strFile As String Dim inti As Integer Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Sheets("Daten").Columns("E").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "*@*" And cell.Offset(0, -1).Value = "yes" Then Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .ActiveInspector.OutMail .GetInspector.CommandBars.FindControl(, 719).Execute .Importance = olImportanceHigh .SentOnBehalfOfName = ("XXXXXXX@XXXXX.com") .To = cell.Value .CC = cell.Offset(0, 1).Value .Subject = UserForm1.txtSubj.Text & " - " & cell.Offset(0, 2).Value .Body = "Dear " & cell.Offset(0, -4).Value & " " & cell.Offset(0, -3).Value & "," & vbNewLine & vbNewLine & _ UserForm1.txtBody.Text & vbNewLine & vbNewLine For inti = 0 To lbBeilagen.ListCount - 1 .Attachments.Add lbBeilagen.List(inti) Next inti '.Send ' Send = sendet Mail sofort .Display ' Display = Mailfenster anzeigen End With Set OutMail = Nothing End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True Unload Me End Sub DirtyMike Nach oben