(25.02.2018, 14:03)Kamilla schrieb: Das Makro welches die Bestellung jetzt zusammenfasst und in eine neue Arbeitsmappe verschiebt befindet sich in der Bestelldatei. Ich möchte nur dieses Makro erweitern, dass es gleich das erstellte Arbeitsblatt umbenennt und mit Outlook versendet.Das lässt sich sicher machen. Aber: Eine bestehende, unbekannte Prozedur ergänzen mit dem vorhandenen Wissensstand ist nun doch etwas riskant und aufwändig. Poste doch mal die vorhandene Prozedur und wenn möglich die involvierten Arbeitsmappen. Vielleicht hilft das dann weiter.
Unten findest Du einen Code, der solche Tabellen verschickt. Aber damit kannst Du sicher nichts anfangen. Er soll Dir nur zeigen, dass "es geht" wenn man es richtig macht.
Code:
Sub versenden()
Dim MyMessage As Object, MyOutApp As Object
strQuelle = "Mitgliederliste"
sngJahr = ThisWorkbook.Sheets("drucken_versenden").Range("C1")
strErweiterung = VBA.Mid(ActiveWorkbook.Name, VBA.InStrRev(ThisWorkbook.Name, ".", -1))
strDokument = strQuelle & " " & sngJahr & strErweiterung
'prüfen, ob die Datenquelle geöffnet ist
strFokus = "Mitgliederliste " & sngJahr & strErweiterung
Datei_geöffnet_prüfen
If bolDateiGeöffnet = True Then
MsgBox "Eine Datei """ & strFokus & """ist geöffnet." & VBA.Chr(13) & VBA.Chr(10) & _
"Schliesse bitte die Datei """ & strFokus & """ ." & VBA.Chr(13) & VBA.Chr(10) & _
"Betätige noch einmal den """ & strCaption & """-Button."
GoTo Endhandler
End If
'prüfen, ob die Datenquelle im Ordner "MITGLIEDERLISTE" vorhanden ist
strPfad = VBA.Left(ThisWorkbook.Path, VBA.InStrRev(ThisWorkbook.Path, "\", -1) - 1) & "\" & VBA.UCase(VBA.Left(strFokus, VBA.InStr(strFokus, " ") - 1))
strFile = strPfad & "\" & strFokus
Quelle_vorhanden
If bolQuelleExistiert = False Then
MsgBox "Eine Datei """ & strFokus & """ im Verzeichnis " & VBA.Chr(13) & VBA.Chr(10) & _
"" & strPfad & "" & VBA.Chr(13) & VBA.Chr(10) & _
"gibt es nicht."
GoTo Endhandler
End If
'Application.ScreenUpdating = False
'Nachrichtenobject erstellen
Dim Mldg, Stil, Titel, Hilfe, Ktxt, Antwort, Text1
Mldg = "Wenn Du die Mail an alle Senioren verschicken willst" & VBA.Chr(13) & VBA.Chr(10) & _
"klicke auf OK, andernfalls klicke auf Abbrechen und wähle die Adressen aus Deinem persönlichen Verzeichnis."
Stil = vbOKCancel + vbDefaultButton2
Titel = "Überprüfung des Ausdruckes" ' Titel definieren.
Antwort = MsgBox(Mldg, Stil, Titel, Hilfe, Ktxt)
If Antwort = vbOK Then
'die Adressen aus der Datenquelle "Mitgliederliste" komponieren
Call strAdresse_komponieren
Else
'die Adressierung erfolgt von Hand
strAdresse = ""
End If
Call AuflistenInhaltTEMPORAER_VERSAND
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
'Application.ScreenUpdating = True
'Application.ScreenUpdating = False
With MyMessage
'hier ist aus der Adressenliste der Empfängerstring zu komponieren
.To = strAdresse
'.To = "robertekunz@bluewin.ch" 'strAdresse '"robertekunz@bluewin.ch" ';anton.hofmann@bluewin.ch"
If strAdresse <> "" Then strMitteilung = "Mitteilung an die Seniorenturner" Else strMitteilung = ""
.Subject = strMitteilung
'Hier wird die temporär gespeicherte Datei als
'Attachment zugefügt
On Error Resume Next
If AWS1 <> "" Then .Attachments.Add AWS1
If AWS2 <> "" Then .Attachments.Add AWS2
If AWS3 <> "" Then .Attachments.Add AWS3
If AWS4 <> "" Then .Attachments.Add AWS4
If AWS5 <> "" Then .Attachments.Add AWS5
If AWS6 <> "" Then .Attachments.Add AWS6
'Hier wird eine normale Text Mail erstellt
.Body = "Deine Mitteilung:"
'Hier wird die HTML Mail erstellt
'.HTMLBody = "Bitte den Anhang lesen und in einer für Dich geeigneten Form ablegen." & vbCrLf & _
"Dies ist ein Test: Turnprogramm Sommer 2011 per E-Mail. Bitte löschen! Es läuft schon fast automatisch."
'Hier wird die Mail nochmals angezeigt
.Display
Kill AWS1
Kill AWS2
Kill AWS3
Kill AWS4
Kill AWS5
Kill AWS6
End With
Set MyOutApp = Nothing
Set MyMessage = Nothing
Application.ScreenUpdating = True
Endhandler:
End Sub
Gruss
Ein Lob ist der Lohn
Ein Tadel der Ansporn
Ein Lob ist der Lohn
Ein Tadel der Ansporn
