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
|