Guten Abend zusammen,
ich habe eine Tabelle in der ich ein Makro für das Versenden einer E-Mail mittels Commandbutton erstellt habe.
Da dieser Button zu oft unbeabsichtigt geklickt wird und man mir so das Postfach zumüllt, würde ich gerne eine Passwortabfrage vorschalten.
Heißt:
Man klickt auf den Commandbutton, in welches ein PW eingetragen werden muss. Wenn korrekt, dann wird die Mail verschickt, ansonsten wird das Makro beendet.
Sub SendMail()
Mein Code soweit...
Dim entity As String
Dim Outlook As Object
Dim Message As Object
Dim attachmentPath As String
Dim path As String
Dim i As Integer
Const year As Integer = "2018"
Dim List As Worksheet
Set List = ActiveWorkbook.Worksheets("Invest")
Set Outlook = CreateObject("Outlook.Application")
Set Message = Outlook.CreateItem(0)
entity = List.Cells(3, 8).Value 'GesellschaftsNr aus Zelle H3
entityname = List.Cells(10, 2).Value 'GesellschaftsNr aus Zelle H2
If entity = "" Then
MsgBox ("Bitte geben Sie den Standort in Zelle H2 an.")
List.Activate
Cells(2, 8).Select
Exit Sub
End If
If List.Cells(5, 8) = "" Then
MsgBox ("Bitte geben Sie das Versionsdatum in Zelle H5 an.")
List.Activate
Cells(5, 8).Select
Exit Sub
End If
If List.Cells(9, 22) <> 0 Then
MsgBox ("Bitte füllen Sie alle Pflichtfelder aus!")
List.Activate
Cells(9, 22).Select
Exit Sub
End If
If List.Cells(4, 8) = "" Then
MsgBox ("Bitte geben Sie einen Ansprechpartner in Zelle H4 an.")
List.Activate
Cells(4, 8).Select
Exit Sub
End If
path = ActiveWorkbook.path
ActiveWorkbook.SaveCopyAs (path & "\Plan" & "2019_" & entity & " " & entityname & ".xlsm")
attachmentPath = path & "\Plan" & "2019_" & entity & " " & entityname & ".xlsm"
'---> Versand der Datei via Outlook
With Message
.To = "Alex"
.Subject = "Plan " & "2019" & " " & entityname
.Attachments.Add attachmentPath
On Error GoTo Label
.send
End With
Set Outlook = Nothing
Set Message = Nothing
Kill attachmentPath 'Kopie der Planungsdatei wird gelöscht
MsgBox ("Datei wurde versandt. Vielen Dank!")
Exit Sub
Label:
Kill attachmentPath
MsgBox ("Datei wurde NICHT versandt. Drücken Sie den Versendebutton erneut. " & vbNewLine _
& "Zum Versenden das Outlook Fenster mit ""JA"" anklicken. " & vbNewLine & "Vielen Dank!")