PDA

Vollständige Version anzeigen : Excel Datei Speichern, Mail versenden & MSGbox "ja - nein"


FtPorter
10.07.2014, 10:49
Hallo liebe Community,

folgenden Code nutze ich, um aus Excel Mails zu versenden:

Private Sub CommandButton1_Click()
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
'Aktive Arbeitsmappe wird als Mail gesendet
'AWS = ThisWorkbook.FullName
InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "Heinz.Mustermann@Musterdorf.com"
.Subject = "Phase ot Process" & Date
'.attachments.Add AWS
.Body = "Sehr geehrter Bearbeiter," & vbCrLf & "" & vbCrLf & "anbei erhalten Sie eine weitere Artikelnummer zur direkten Weiterbearbeitung im Rahmen unsers Auslaufprozesses." & vbCrLf & "" & vbCrLf & "Bitte um entsprechende Bearbeitung!" & vbCrLf & "" & vbCrLf & "Im Voraus besten Dank für Ihre Mühe."
.cc = "erna.mustermann@musterdorf.com"
.Attachments.Add ThisWorkbook.FullName
.Send
'Hier wird die Mail gleich in den Postausgang gelegt
'Mail.send
End With
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub


Der Code macht exakt was er soll.
nun möchte ich diesen um folgende Bestandteile erweitern:

1. automatisch vor dem Senden an einem definierten Speicherort speichern
2. Body aus code übernehmen
3. MSGbox integrieren, die den User nochmal fragt, wollen Sie senden / ja Nein?
4. Signatur von Outlook automatisch von demjenigen übernhemen der den CommandButton drückt (sofern beim entsprechenden User dies so eingestellt ist (Neue Nachricht = verwende Signatur ABC... Ihr wisst sicher was ich meine).


Hat jemand eine gute und schnelle Lösung parat?

Ich bedanke mich schon mal im Voraus und freue mich auf entsprechende Lösungsansätze.

Grüße
Christian (FtPorter)

FtPorter
16.07.2014, 09:00
Hallo,

hat niemand einen etwaigen Lösungsansatz / Vorschlag? :upps:

Mc Santa
16.07.2014, 09:58
Hallo,

Bei Punkt 2 verstehe ich nicht genau, was du damit meinst und Punkt 4 hat bei mir noch nie zuverlässig funktioniert.
Daher eine Lösung für Punkt 1 und 3:
Option Explicit

Private Sub CommandButton1_Click()

If vbYes = MsgBox("Wollen Sie wirklich speichern und senden?", vbYesNo + vbQuestion, "Email verschicken") Then

ActiveWorkbook.SaveAs Filename:="C:\Temp\" & ThisWorkbook.Name

Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")

Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "Heinz.Mustermann@Musterdorf.com"
.Subject = "Phase ot Process" & Date
.Body = "Sehr geehrter Bearbeiter," & vbCrLf & "" & vbCrLf & "anbei erhalten Sie eine weitere Artikelnummer zur direkten Weiterbearbeitung im Rahmen unsers Auslaufprozesses." & vbCrLf & "" & vbCrLf & "Bitte um entsprechende Bearbeitung!" & vbCrLf & "" & vbCrLf & "Im Voraus besten Dank für Ihre Mühe."
.Cc = "erna.mustermann@musterdorf.com"
.Attachments.Add ThisWorkbook.FullName
.Send

End With
Set OutApp = Nothing
Set Nachricht = Nothing
End If
End Sub

Das Speichern ist noch komplett ohne Fehlerbehandlung und gibt eine Fehler, wenn beispielsweise der Pfad nicht vorhanden ist, oder darauf nicht zugegriffen werden darf.

Hilft dir das weiter?
VG

FtPorter
16.07.2014, 11:34
Huhu Mc Santa,

Vielen Dank mal für den Code.

MSGbox klappt prima.

Punkt 2 = Body aus VBA:
.Body = "Sehr geehrter Bearbeiter," & vbCrLf & "" & vbCrLf & "anbei erhalten Sie eine weitere Artikelnummer zur direkten Weiterbearbeitung im Rahmen unsers Auslaufprozesses." & vbCrLf & "" & vbCrLf & "Bitte um entsprechende Bearbeitung!" & vbCrLf & "" & vbCrLf & "Im Voraus besten Dank für Ihre Mühe."

hatte ich ja schon im Code "vercodet" :upps:

Speicherort habe ich auf "H:\Testdatei" gelegt.

beim Click auf den Commandbutten kommt auch vor dem Senden der Hinweis dass er speichert, leider finde ich die Datei unter dem Pfad, wie oben beschrieben nicht.

SaveAs meint ja auch Speichern unter, sollte also funktionieren.
Hast du da eine Idee?
Ja das mit den Zugriffsrechten auf unserem Server ist schon so eine Sache. aber ich speicher die Datei an einem Ort, wo jeder volle Schreib- und Leserechte hat. Somit ist eine Was / Wenn abfrage in VBA nich wirklich von Nöten.

Christian

Ahhhhhhh

habe es glaube ich gefunden... er speichert die Datei zwar unter dem Laufwerk H: ab, aber den Pfad gibt als Bestandteil des namens wieder, statt die Datei unter dem Pfad zu speichern. :)

Komisch... BTW... könntest Du mir den Code verraten, wie ich dem Makro Sage: Ersetze den Originalnamen der Datei mit dem Namen aus Zelle R1 von Tabelle2?

Das würde es noch ein wenig runder machen :)

Danke Christian

Mc Santa
16.07.2014, 11:54
Hallo,

du suchst etwa folgende Zeile zum Speichern:
ActiveWorkbook.SaveAs Filename:="H:\Testdatei\" & ThisWorkbook.Worksheets("Tabelle2").Range("R1").Value

Wichtig ist der \ (Backslash) nach Testdatei!


Weiterhin gibt es keine Fehlerbehandlung, also musst du zusätzlich darauf achten, keine verbotenen Zeichen in der entsprechenden Zelle stehen zu haben.

Hilft dir das?

VG

FtPorter
16.07.2014, 12:18
Hi Santa,

ja funzt super. Komischerweise auch jetzt wie es soll... sehr sehr seltsam, da ich den \ hinter dem namen Testdatei vorhin auch schon hatte... Naja wird wohl das MS-Excel Phantom wieder zugeschlagen haben :)

noch eine letzte Frage zu diesem Thema hier, dann ist es endgültig gelöst...

In Zelle R1 befindet sich eine Kombination aus Buchstaben / DATUM und Zahlen...

Die Formel lautet:

=VERKETTEN(B1;"_";C3;"_";C7;"_";C11)

in C3 steht ein Datum z.B. der 14.07.2014 dies wird aber im Zuge der Verkettung als 41834 dargestellt. wie erreiche ich, dass das tatsächliche Datum, statt der Zahlenkombination gezogen wird.

hmmm... ok 14(.) usw... der Punkt, wird im Dateinamen sicherlich für Verwirrung sorgen... dann müsste praktisch der Punkt noch durch einen weiteren Unterstrich, oder der Übersichtlichkeit halber durch ein Minus ersetzt werden, oder?

Verstehst Du was ich meine?

Christian

Mayden
16.07.2014, 12:56
Versuch doch mal das :)

=VERKETTEN(B1;"_";TEXT(C3; "TT-MM-JJJJ");"_";C7;"_";C11)

FtPorter
16.07.2014, 13:36
Hi Mayden,

Vielen Dank. Stimmt das war es, warum bin ich da nicht selbst drauf gekommen?

Hey Ihr 2 Ich danke euch für die Lösungsansätze / Komplettlösungen wie verrückt!

Tollen Support / Job gemacht!:hands:

Christian

FtPorter
18.07.2014, 08:15
Hallo nochmal,

Frage:

Kann ich den Code: Option Explicit

Private Sub CommandButton1_Click()

If vbYes = MsgBox("Wollen Sie wirklich speichern und senden?", vbYesNo + vbQuestion, "Email verschicken") Then

ActiveWorkbook.SaveAs Filename:="C:\Temp\" & ThisWorkbook.Name

Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")

Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "Heinz.Mustermann@Musterdorf.com"
.Subject = "Phase ot Process" & Date
.Body = "Sehr geehrter Bearbeiter," & vbCrLf & "" & vbCrLf & "anbei erhalten Sie eine weitere Artikelnummer zur direkten Weiterbearbeitung im Rahmen unsers Auslaufprozesses." & vbCrLf & "" & vbCrLf & "Bitte um entsprechende Bearbeitung!" & vbCrLf & "" & vbCrLf & "Im Voraus besten Dank für Ihre Mühe."
.Cc = "erna.mustermann@musterdorf.com"
.Attachments.Add ThisWorkbook.FullName
.Send

End With
Set OutApp = Nothing
Set Nachricht = Nothing
End If
End Sub

Entsprechend so erweitern, dass z.B. in Zelle D4 die Adresse Mailto steht und D5 die dazugehörige CC-Adresse? Dies würde ich dann über Datenüberprüfung / Liste lösen wollen.

Das Makro sollte dann in diesem Fall auf die 2 Zellen greifen und die entsprechenden Adressen picken und integrieren.
Bei einer Auswahl "SELECT" (aus der Liste = Überschrift), sollte eine Warnung kommen (VBCritical) ACHTUNG Sie müssen eine gültige Emailadresse wählen!

Geht das reletiv einfach, oder ist der Aufwand hierfür mega groß? :rolleyes:

Bitte um erneute Unterstützung.

Bei Fragen, bitte fragen.

Gruß und schon mal Vielen Dank im Vorraus.

Christian

Mc Santa
18.07.2014, 08:27
Hallo,

schau mal ob du mit diesem Code glücklich wirst:
Falls eine keine To-Adresse geählt, wird keine Mail verschickt,
Sonst erwscheint die Abfrage und ggf der Versand. Die Auswahl einer CC-Adresse ist derzeit nicht notwendig, und die Auswahl wird korrigiert, falls nichts gewählt wurde.

Option Explicit

Private Sub CommandButton1_Click()

Dim mailTo As String, mailCc As String
mailTo = Range("D4")
mailCc = Range("D5")

If mailTo = "SELECT" Then 'keine Auswahl
MsgBox "Sie müssen eine gültige Emailadresse wählen", vbCritical + vbOKOnly, "Achtung"
Else 'AN Adresse wurde gewählt

If vbYes = MsgBox("Wollen Sie wirklich speichern und senden?", vbYesNo + vbQuestion, "Email verschicken") Then

'Falls keine CC gewählt, wird die Adresse auf "" gesetzt, Mail wird trotzdem verschickt!
If mailCc = "SELECT" Then mailCc = ""

ActiveWorkbook.SaveAs Filename:="C:\Temp\" & ThisWorkbook.Name

Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")

Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "Heinz.Mustermann@Musterdorf.com"
.Subject = "Phase ot Process" & Date
.Body = "Sehr geehrter Bearbeiter," & vbCrLf & "" & vbCrLf & "anbei erhalten Sie eine weitere Artikelnummer zur direkten Weiterbearbeitung im Rahmen unsers Auslaufprozesses." & vbCrLf & "" & vbCrLf & "Bitte um entsprechende Bearbeitung!" & vbCrLf & "" & vbCrLf & "Im Voraus besten Dank für Ihre Mühe."
.Cc = "erna.mustermann@musterdorf.com"
.Attachments.Add ThisWorkbook.FullName
.Send

End With
Set OutApp = Nothing
Set Nachricht = Nothing
End If
End Sub

Fragen und Feedback sind willkommen :)
VG

FtPorter
18.07.2014, 08:53
Huhu Mc Santa,

im Moment schickt er nach wie vor die Mail an die Adresse wie hier im Code:

Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "Heinz.Mustermann@Musterdorf.com"
.Subject = "Phase ot Process" & Date
.Body = "Sehr geehrter Bearbeiter," & vbCrLf & "" & vbCrLf & "anbei erhalten Sie eine weitere Artikelnummer zur direkten Weiterbearbeitung im Rahmen unsers Auslaufprozesses." & vbCrLf & "" & vbCrLf & "Bitte um entsprechende Bearbeitung!" & vbCrLf & "" & vbCrLf & "Im Voraus besten Dank für Ihre Mühe."
.Cc = "erna.mustermann@musterdorf.com"
.Attachments.Add ThisWorkbook.FullName
.Send


Die andere selektierte bringt zwar keine Fehlermeldung (Debugging), aber ich sehe in outlook nur, dass Mustermann die Mail erhalten hat.

Muss der Code wie oben beschrieben der neuen Prozedur noch angepasst werden? Ach bevor ich es vergesse, der String: .Body... sollte gerne erhalten bleiben ;)

Danke und Gruß
Christian

FtPorter
18.07.2014, 08:59
Hi Mc Santa,

habe Code wie folgt angepasst:


Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = mailTo
.Subject = "Phase ot Process" & Date
.Body = "Sehr geehrter Bearbeiter," & vbCrLf & "" & vbCrLf & "anbei erhalten Sie eine weitere Artikelnummer zur direkten Weiterbearbeitung im Rahmen unsers Auslaufprozesses." & vbCrLf & "" & vbCrLf & "Bitte um entsprechende Bearbeitung!" & vbCrLf & "" & vbCrLf & "Im Voraus besten Dank für Ihre Mühe."
.Cc = mailCc
.Attachments.Add ThisWorkbook.FullName
.Send

und es scheint zu funktionieren!

kannst du bitte nur schnell die Richtigkeit des CODES bestätigen?

Vielen Dank

Christian

Mc Santa
18.07.2014, 09:05
Hi Mc Santa,

habe Code wie folgt angepasst:


Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = mailTo
.Subject = "Phase ot Process" & Date
.Body = "Sehr geehrter Bearbeiter," & vbCrLf & "" & vbCrLf & "anbei erhalten Sie eine weitere Artikelnummer zur direkten Weiterbearbeitung im Rahmen unsers Auslaufprozesses." & vbCrLf & "" & vbCrLf & "Bitte um entsprechende Bearbeitung!" & vbCrLf & "" & vbCrLf & "Im Voraus besten Dank für Ihre Mühe."
.Cc = mailCc
.Attachments.Add ThisWorkbook.FullName
.Send

und es scheint zu funktionieren!

kannst du bitte nur schnell die Richtigkeit des CODES bestätigen?

Vielen Dank

Christian

Hallo,

ja, genau, so sollte es aussehen :)

VG

FtPorter
18.07.2014, 09:16
Ai Perfetto :)

Was würde ich nur ohne deine Hilfe machen?!?

Vielen lieben Dank!!!!!!

Christian

Mc Santa
18.07.2014, 09:26
Immerhin korrigierst du schon meine Fehler :)

VBA ist nicht so schwer und im Forum findest du häufig Leute, die dir helfen.

VG