E-Mail

Forumthread: E-Mail

E-Mail

14.02.2021 15:53:47

Hallo zusammen,
ich möchte eine Mail versenden per Makros. Es funktioniert alles super, außer das der kopierte Bereich aus Excel nicht am Ende der Mail steht sondern ganz oben eingefügt wird.
Dadurch steht der Text, der eigentlich oben stehen sollte nun unten...
Wie löse ich das?
Hier der Code:

Sub Preisupdate()
Sheets("Preisanfrage").Select
ActiveSheet.Range("A2:AC30000").AutoFilter
Sheets("Preisanfrage").Range("A2:AC30000").AutoFilter 22, Criteria1:= _
xlFilterToday, Operator:=xlFilterDynamic
Range("A2").CurrentRegion.Select
Selection.Copy
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "xxx"
.CC = "xxx"
.Subject = "Preisupdate"
.Body = "Hallo Zusammen," & vbCr & vbCr & "hier das Preisupdate für heute:" & vbCr & vbCr & " _
Viele Grüße" & vbCr & vbCr
.Display
End With
'Kurz warten, damit die Mail Zeit zum Öffnen hat
Application.Wait (Now + TimeValue("0:00:03"))
' Dann die Zwischenablage einfügen
Application.SendKeys ("^v")
End Sub

Danke euch

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: E-Mail

14.02.2021 16:49:58

fcs
AW: E-Mail

14.02.2021 17:39:09

volti
AW: E-Mail

14.02.2021 21:51:01

cs

AW: E-Mail

14.02.2021 16:49:58

fcs

Hallo cs,
SendKeys kann Probleme machen - ich verwende es möglichst nicht.
Ich hab eine zusätzliche SendKeys-Zeile eingefügt, die den Cursor ans Ende des E-Mailtextes steuert und dann den Inhalt aus Excel einfügt.
Scheint zu funktionieren.
LG
Franz

Sub Preisupdate()
Sheets("Preisanfrage").Select
ActiveSheet.Range("A2:AC30000").AutoFilter
Sheets("Preisanfrage").Range("A2:AC30000").AutoFilter 22, Criteria1:= _
xlFilterToday, Operator:=xlFilterDynamic
Range("A2").CurrentRegion.Select
Selection.Copy
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "xxx"
.CC = "xxx"
.Subject = "Preisupdate"
.Body = "Hallo Zusammen," & vbCr & vbCr & "hier das Preisupdate für heute:" & vbCr & vbCr _
& "Viele Grüße" & vbCr & vbCr
.Display
End With
'Kurz warten, damit die Mail Zeit zum Öffnen hat
Application.Wait (Now + TimeValue("0:00:03"))
' Ende der E-mail ansteuern
Application.SendKeys ("+^{END}")
' Dann die Zwischenablage einfügen
Application.SendKeys ("^v")
End Sub

AW: E-Mail

14.02.2021 17:39:09

volti

Hallo CS,
es geht auch ohne SendKeys....

Code:


[Cc][+][-]

Sub Preisupdate()
  Dim objOutlook As Object
  Dim objMail As Object
  Dim sMailText As String

  Sheets("Preisanfrage").Select
  ActiveSheet.Range("A2:AC30000").AutoFilter
  Sheets("Preisanfrage").Range("A2:AC30000").AutoFilter 22, Criteria1:= _
  xlFilterToday, Operator:=xlFilterDynamic
  Range("A2").CurrentRegion.Select
  Selection.Copy

  Set objOutlook = CreateObject("Outlook.Application")
  Set objMail = objOutlook.CreateItem(0)

  sMailText = "Hallo Zusammen," & vbCr & vbCr & "hier das Preisupdate für heute:" _
  & vbCr & vbCr & "Viele Grüße" & vbCr & vbCr
  With objMail
      .To = "xxx"
      .CC = "xxx"
      .Subject = "Preisupdate"
      .Body = sMailText
      .Display
      With .GetInspector.WordEditor.Application.Selection
          .Start = Len(sMailText)
          .Paste                               ' Bereich in Mail einfügen
      End With

  End With

End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

AW: E-Mail

14.02.2021 21:51:01

Sehr cool.
Es funktioniert.
Vielen Dank für die Hilfe

Beliebteste Forumthreads (12 Monate)

Forumthread: E-Mail

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread