Hallo zusammen, ich habe ein Problem zu meinem aktuellen Makro zum Mailversand.
Genau nur dann, wenn ich den Adressaten aus der Tabelle entnehmen will.
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
If Sheets(1).Cells(1, 16) = "" Then
AWS = Environ("USERPROFILE") & "\" & Sheets(1).Range("D2") & Sheets(1).Range("N3") & Sheets(2).Range("E2") & ThisWorkbook.Name
End If
AWS = Environ("USERPROFILE") & "\" & ThisWorkbook.Name
ThisWorkbook.SaveCopyAs AWS
Application.Visible = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = Sheets(1).Range("Q3")' die Adresse wird nicht aus der Zelle übernommen!
'.Cc =
.Subject = "Bitte um " & Sheets(1).Range("D2") & " " & Sheets(1).Range("N3") & " " & Sheets(1).Range("O2") & " " & Sheets(2).Range("E2") & " .xls"
.Attachments.Add AWS
.Body = "Hallo zusammen, bitte ...!" & vbCrLf & ""
.Display
End With
Set OutApp = Nothing
Set Nachricht = Nothing
With Sheets(1)
.Unprotect
.Range("G2").Select
Cells.Replace What:=":", Replacement:=".", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Protect
End With
Ändere ich den Empfänger indem ich eine Eindeutige Adresse vorweg eintrage, dann gibt es kein Problem, als dann wird auch die aus der Zelle übernommen?
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
If Sheets(1).Cells(1, 16) = "" Then
AWS = Environ("USERPROFILE") & "\" & Sheets(1).Range("D2") & Sheets(1).Range("N3") & Sheets(2).Range("E2") & ThisWorkbook.Name
End If
AWS = Environ("USERPROFILE") & "\" & ThisWorkbook.Name
ThisWorkbook.SaveCopyAs AWS
Application.Visible = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "abc@mail.de" & ";" & Sheets(1).Range("Q3")' die Adresse wird nun aus der Zelle übernommen!
'.Cc =
.Subject = "Bitte um " & Sheets(1).Range("D2") & " " & Sheets(1).Range("N3") & " " & Sheets(1).Range("O2") & " " & Sheets(2).Range("E2") & " .xls"
.Attachments.Add AWS
.Body = "Hallo zusammen, bitte ...!" & vbCrLf & ""
.Display
End With
Set OutApp = Nothing
Set Nachricht = Nothing
With Sheets(1)
.Unprotect
.Range("G2").Select
Cells.Replace What:=":", Replacement:=".", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Protect
End With
hier gibt es also nur ein Problem wenn führend keine eindeutige Mailadresse in den Quellcode eingetragen wird.
Hat jemand eine Idee wir ich nur die Adresse aus der Zelle übernehme?
In der Beispieldatei wird es verdeutlicht.
https://www.herber.de/bbs/user/115097.xls
Liebe Grüße Lisa