E-Mail versenden
29.10.2019 08:47:41
Thomas
folgendes Problem:
in meinem Code wird eine E-Mail erstellt, sobald entsprechende Zelle in der die Spalte D geändert wird.
Beispiel:
Zelle D3 ist leer und wird mit einem x versehen. Dann wird durch das x eine E-Mail erstellt. ABER ich bekomme es nicht hin das die E-Mailadresse eingetragen wird die in Zell B3 steht.
Wenn D16 aktiviert wird soll die E-Mail Adresse von B16 genommen werden usw.
Also egal welche Zelle in D beschrieben wird es steht im die entsprechende Adresse in Spalte B
Hoffe ihr könnt mir helfen.
Danke euch schonmal im voraus.
Gruß Thomas
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xRg = Range("D:D")
Set xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Hallo " & xRgSel.Address(False, False) & _
" in the worksheet '" & Me.Name & "' were modified on " & _
Format$(Now, "dd/mm/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
" by " & Environ$("username") & "."
With xMailItem
.To = "E-Mail Adresse"
.Subject = "APX von BMW bereitgestellt"
.Body = xMailBody
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub