Tabelle an Outlook übergeben incl. Textbausteine

[depi1962]

Moin,

ich suche jetzt bereits seit Tagen nach einer Lösung für mein Problem:
- es soll eine Tabelle an Outlook übergeben werden (nicht sofort gesendet)
- der Empfänger, Betreff und Text werden aus der Tabelle vorgegeben
- der Anwender soll dann händisch auf senden klicken, nach Sichtung

Ich bekomme in den Code einfach nicht hin, dass die Tabelle mit in der E-Mail erscheint

Code:

Sub Senden()

   Dim Email As String
   Dim Betreff As String
   Dim Text As String
   Email = Range("z11").Value
   Betreff = "Achtung: " & Range("I5").Value

   Text = "Sehr geehrte Damen und Herren," & "%0D%0A" & "%0D%0A" & _
     "es wurde ..." & _
     "Bei Fragen stehen wir gerne zur Verfügung."

    Call ShellExecute(0&, "Open", "mailto:" + Email + _
     "?Subject=" + Betreff + "&Body=" + Text, "", "", 1)

End Sub

ab Call verstehe ich das Makro nicht mehr

Ich bitte euch hier um Hilfe
Grüße Detlef

[volti]

Hallo Detlef,

die Shellexecute öffnet eine Datei anhand Ihres Suffix oder eben wie in Deinem Fall einen (eMail)Link. Ich glaube nicht, dass damit eine Tabelle übergeben werden kann.

Hier mal eine Alternative zum Versand eines Tabellenblattes.

Code:

Private Sub Mailsenden()
  Dim sDateiname As String
  
' Tabellenblatt speichern
  ActiveSheet.Copy
  With Application.ActiveWorkbook
     sDateiname = Environ$("temp") & "\" & .Name & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx"
    .SaveAs sDateiname, FileFormat:=xlOpenXMLWorkbook
    .Close                          ' Mappe schließen
  End With
  
  With CreateObject("Outlook.Application").CreateItem(0)
      .Getinspector
      .To = Range("z11").Value
      .CC = ""
      .Bcc = ""
      .Subject = "Achtung: " & Range("I5").Value
      .htmlbody = "Sehr geehrte Damen und Herren,<br><br>" _
                & "es wurde ..." _
                & "Bei Fragen stehen wir gerne zur Verfügung.<br> " _
                & .htmlbody
      .Display
      .Attachments.Add sDateiname   ' Datei an Mail anfügen
      Kill sDateiname               ' Datei wieder löschen
  End With
End Sub

_________
viele Grüße
Karl-Heinz

[depi1962]

Danke Karl-Heinz
daraus ergeben sich noch 2 Problemchen
- die Tabelle ist mit Makros und diese soll sie auch behalten beim Senden
- die Namensgebung wird in der Tabelle vorgegeben - Zelle i5

ich bastel und probiere, aber es klappt nicht

[volti]

Hallo,

so sollte es gehen...

Code:

Private Sub Mailsenden()
  Dim sDateiname As String
  
' Tabellenblatt speichern
  ActiveSheet.Copy
  With Application.ActiveWorkbook
     sDateiname = Environ$("temp") & "\" & Range("I5").Value
     If Not sDateiname Like ".xls*" Then sDateiname = sDateiname & ".xlsm"
    .SaveAs sDateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    .Close                          ' Mappe schließen
  End With
  
  With CreateObject("Outlook.Application").CreateItem(0)
      .Getinspector
      .To = Range("z11").Value
      .CC = ""
      .Bcc = ""
      .Subject = "Achtung: " & Range("I5").Value
      .htmlbody = "Sehr geehrte Damen und Herren,<br><br>" _
                & "es wurde ..." _
                & "Bei Fragen stehen wir gerne zur Verfügung.<br> " _
                & .htmlbody
      .Display
      .Attachments.Add sDateiname   ' Datei an Mail anfügen
      Kill sDateiname               ' Datei wieder löschen
  End With
End Sub

_________
viele Grüße
Karl-Heinz

[depi1962]

Moin in die Runde - Hallo Karl-Heinz

das letzte Script kam mit Fehler
vllt. geht es hiermit besser
mit einem speichern Script erzeugen wir aus der Vorlage mit Makros eine Datei XLSM; der Name wir aus Zelle i5 gewonnen
das Script vermailt jetzt diese Datei, leider ohne Eingriffsmöglichkeit Signatur oder Text im Body hinzuzufügen
komen wir hier vllt. weiter und könnend as Senden abfangen?

ich danke Allen im Voaus
Detlef

Code:

Sub Senden()


Dim sWert As String, aWert As String
Dim sPath As String
Application.ScreenUpdating = False
On Error GoTo HALLO
sWert = "Achtung: " & Range("I5").Value 'Betreff in der Mail
aWert = Range("z11").Value  'Name der Datei
If "g7" <> "" Then
       GoTo weiter
End If
weiter:
ActiveWorkbook.SendMail Recipients:=aWert, Subject:=sWert, ReturnReceipt:=True
GoTo ENDE
HALLO:
    MsgBox "Es ist kein Empfänger ausgewählt!", vbCritical, "Hinweis"
ENDE:
Application.ScreenUpdating = True
End Sub

[volti]

Hallo Detlef,

das Makro für den Mailversand enthält keine Fehler und läuft bei mir fehlerfrei (Outlook) durch.
Sollte es wider Erwarten bei Dir tatsächlich zu Problemen kommen, musst Du uns schon mitteilen, wo und vor allem welcher Fehler auftritt, sonst kann Dir niemand anhand der Aussage "Da ist ein Fehler.." helfen.
Hier noch mal eine Version, die keine HTML sondern eine normale eMail erstellt.

Zu Deinem neuen Scriptansatz:
Application.ScreenUpdating ist überflüssig, es erfolgt ja kein Zugriff auf eine Zelle
If "g7" <> "" Then ist immer wahr
Du kannst das Application.SendMail gern verwenden. ailWarum das jetzt besser sein soll, insbesondere in Bezug auf Deine Fragen, ist mir unklar.

Aber vielleicht hat ja jemand anderes die passende Idee.

Code:

Private Sub Mailsenden()
  Dim sDateiname As String
  
' Tabellenblatt speichern
  ActiveSheet.Copy
  With Application.ActiveWorkbook
     sDateiname = Environ$("temp") & "\" & Range("I5").Value
     If Not sDateiname Like ".xls*" Then sDateiname = sDateiname & ".xlsm"
    .SaveAs sDateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    .Close                          ' Mappe schließen
  End With
  
  With CreateObject("Outlook.Application").CreateItem(0)
      .Getinspector
      .To = Range("z11").Value
      .CC = ""
      .Bcc = ""
      .Subject = "Achtung: " & Range("I5").Value
      .body = "Sehr geehrte Damen und Herren," & vbLf _
                & "es wurde ..." _
                & "Bei Fragen stehen wir gerne zur Verfügung." & vbLf _
                & .body
      .Display
      .Attachments.Add sDateiname   ' Datei an Mail anfügen
      Kill sDateiname               ' Datei wieder löschen
  End With
End Sub

_________
viele Grüße
Karl-Heinz

[depi1962]

Hallo Karl-Heinz
das Makro verursacht an dieser Stelle den Debugger - Laufzeitfehler 1004
.SaveAs sDateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled

wenn ich ihn zurücksetze, dann hat meine Tabelle nur noch ein Blatt und heißt Mappe1

Gruß Detlef

[volti]

Hallo Detlef,

da musst Du Dir mal über Debug.print oder Msgbox ausgeben lassen, ob der Dateipfad in sDateiname überhaupt gültig ist und auch nicht der aktiven Mappe entspricht..

Oder  hier mal eine Beispielmappe hochladen. Ich kann so keinen Fehler erkennen.

Gruß
Karl-Heinz

[snb]

Schau mal hier:

https://www.snb-vba.eu/VBA_Excelgegevens...ml#L_2.3.1

[schauan]

Hallöchen,

wäre hier nicht ein Stern mehr von Vorteil?

If Not sDateiname Like ".xls*" Then

Hat aber mit dem Fehler nix zu tun