Hallo zusammen,
das Homeoffice macht erfinderisch bzw. muss man versuchen effektiv arbeiten zu können um nebenbei noch Homescholling zu machen.
Ich habe eine sehr große Excel Datei, die ich an verschiedene Leute "D" senden muss. Die Daten der anderen darf der Empfänger nicht sehen. Somit muss ich zuvor die Daten für den jeweiligen Partner filtern.
Ich habe leider absolut keine Ahnung von VBA Codes. Habe schon diverse Videos geschaut und Beiträge gelesen, aber ich komme nicht weiter.
Ich möchte gerne, das ich die gefilterten Daten, per Knopfdruck an die Mail Adresse aus "E" verschicken kann.
Konnte ich mich verständlich ausdrücken?
Mein Sohn dankt Euch für Eure Hilfe ...dann kann der Papa nämlich seine Mathe Aufgaben machen...
Vielen Dank für Eure Unterstützung.
VG
CAOS
Hallöchen,
auch wenn VBA nicht Dein Ding ist versuche ich es trotzdem erst mal nur mit eienm Tipp. Schaue mal bei uns in die Suche. Dort gibt es einige Lösungen wie man per Makro Dateien in eine Email packt und versendet. Im Prinzip musst Du Deine Tabelle filtern, das gefilterte Ergebnis z.B. als pdf speichern, versenden und die pdf kann dann sicher wieder gelöscht werden.
Hallo, vielen Dank vorab für Deine Antwort.
Ich hatte schon gesucht und auch gefunden...nur sollte das Tabellenblatt auch als Excel und eben nicht als PDF verschickt werden. Das hatte ich sogar hinbekommen. Auch wenn es sehr unkomfortabel war, da ich die Empfänger Mail nach wie vor eingeben musste, den Betreff auch noch händisch pflegen musste und es eben eine PDF war.
Ich kann eben den Code nicht allein schreiben. Vielleicht könnt ihr mir weiter helfen.
Wäre klasse.
Vielen Dank!
Hallöchen,
In Deinem Muster hast Du 4 Namen. Du willst zu jedem Namen die entsprechende Zeile nebst Überschriften senden?
Ich habe hier mal mit dem Makrorekorder was aufgezeichnet. Das erzeugt Dir erst mal in C:\Temp eine Exceldatei mit den Inhalten der gefilterten Zeile nebst Überschriften. Wäre das ok? Den Code kann man natürlich noch optimieren
Dann käme als nächster Step das Erzeugen der E-Mail. Die E-Mail-Adresse steht dann ja immer in E3. Was ist aber der Betreff? Soll es auch einen Mailtext geben? AM Ende müsstest Du nur noch "Senden" drücken ...
Code:
Sub Makro1()
'
' Makro1 Makro
'
'
Rows("2:8").Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Columns("A:O").Select
Columns("A:O").EntireColumn.AutoFit
Range("A2").Select
Sheets("Tabelle1").Select
Application.CutCopyMode = False
Sheets("Tabelle1").Move
ChDir "C:\Temp"
ActiveWorkbook.SaveAs Filename:="C:\Temp\MappeTest.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End Sub
Hallo CAOS,
falls Du die Auswertung der Daten nicht mit Anhang als Excelsheet versenden möchtest, sondern die Auswertung direkt in eine Mail einbetten möchtest, kannst Du Dir nachfolgendes Beispiel mal anschauen.
Bei Gefallen kannst Du es entsprechend anpassen, ausbauen und verwenden.
Code:
Option Explicit
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Mail_Senden()
' Sendet Mail mit integriertem Bereich als Bereich mit Signatur
Dim WSh As Worksheet, sBer As String
Dim sMailtext As String
Dim sEmpfaenger As String
Dim iEinf As Integer, iZeile As Long, iBeginn As Long, iEnde As Long
Set WSh = ThisWorkbook.ActiveSheet ' Blatt mit Maildaten und Daten
iZeile = WSh.Cells(Rows.Count, "D").End(xlUp).Row ' Letzte Zeile in Spalte
For iZeile = 4 To iZeile ' erste relevante Zeile ermitteln
If WSh.Rows(iZeile).Hidden = False Then
If InStr(sEmpfaenger, WSh.Cells(iZeile, "E").Value & ";") = 0 Then
sEmpfaenger = sEmpfaenger & WSh.Cells(iZeile, "E").Value & ";"
End If
If iBeginn = 0 Then iBeginn = iZeile
iEnde = iZeile
End If
Next iZeile
If sEmpfaenger = "" Then Exit Sub ' Kein Empfänger =>raus
sEmpfaenger = Left$(sEmpfaenger, Len(sEmpfaenger) - 1)
sBer = "F2:O3,F" & iBeginn & ":O" & iEnde ' Kopierbereich setzen
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 ' 2=HTML-Format
.Subject = "Auswertung der Woche " & WSh.Name ' Betreff
.To = sEmpfaenger ' Empfänger
sMailtext = "Anbei Ihre Daten:¶¶<b>Partner:</b> " & vbTab _
& WSh.Cells(iBeginn, "D").Value & "¶<b>Straße:</b> " _
& WSh.Cells(iBeginn, "C").Value & "¶<b>Ort:</b> " _
& WSh.Cells(iBeginn, "B").Value & "¶¶"
iEinf = Len(sMailtext) - 22 ' Grafik Einfügestelle
sMailtext = "<body style='font-family:Arial; font-size:10pt;color:#000000'>" _
& sMailtext & "</body>" ' Schrift formatieren
.Getinspector: ' Signatur holen
.htmlbody = Replace(sMailtext, "¶", "<br>") & .htmlbody
.Display ' Mail anzeigen
On Error Resume Next
Do
Err = 0: Sleep 100
WSh.Range(sBer).Copy ' Bereich kopieren
If Err = 0 Then Exit Do
Loop
With .Getinspector.WordEditor.Application.Selection
.Start = iEinf: .Paste ' Bereich in Mail einfügen
End With
Rem .Send ' Mail absenden
End With
End Sub
_________
viele Grüße
Karl-Heinz
Hallo,
Vielen Dank und Sorry da sich gestern nicht mehr geantwortet habe.
Also, meine "Wusch" Vorstellung war, das ich nachdem ich die Daten gefiltert habe, auf eine Schaltfläche drücke, und automatisch eine Mail erzeugt wird (Adresse steht immer in Spalte E ) mit der (gefilterten) Excel datei im Anhang.
Wenn dann noch im Betreff stehen würde "Bestand KW) wäre das ein toller Zusatz. Muss aber nicht.
"Mehr" bräuchte ich nicht.
Ich finde es klasse, das ihr Euch so für Fremde Leute engagiert.
Vielen dank!
Hallo Karl Heinz, auch Dir vielen Dank für Deine Antwort.
Ich würde schon gerne die (gefilterten) Daten als Excel Anhang verschicken. Wie zuvor beschrieben bin ich leider nicht der VBA Held. Hatte mir aber vorgestellt, das es Möglich sein müsste, über eine Schaltfläche per Klick die gefilterten Daten als Excel Anhang an die in Spalte E stehende EMail versenden zu können.
Mir scheint, als ob Du das locker kannst
Auch hier noch einmal: Ich finde es toll das ihr Euch so für Fremd Leute engagiert und helft. Klasse.
Vielen Dank!
Hallöchen,
komplettiert, überarbeitet und kommentiert könnte das dann so aussehen. Ich habe hier aber keinen Text und keine Signatur in der EMail, das wolltest Du nicht. Die Endzeilennummer - hier 8 - könnte man übrigens auch automatisieren ...
Code:
Sub Makro2()
'gefilterten Bereich kopieren - ggf. Zeilennummer 8 anpassen!
Rows("2:8").Copy
'neues Blatt einfuegen
Sheets.Add After:=ActiveSheet
'Werte in A2 einfuegen
With Range("A2")
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Ende Werte in A2 einfuegen
End With
'Kopiermarkierung deaktivieren
Application.CutCopyMode = False
'Spaltenbreite setzen
Columns("A:O").EntireColumn.AutoFit
'Blatt in neue Datei verschieben
ActiveSheet.Move
'Verzeichnis wechseln (muss nicht sein)
ChDir "C:\Temp"
'Neue Datei speichern unter
ActiveWorkbook.SaveAs Filename:="C:\Temp\Bestand_KW.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
'Neue Datei schliessen
ActiveWindow.Close
'EMail erzeugen
With CreateObject("Outlook.Application").CreateItem(0)
.Subject = "Bestand KW" ' Betreff
.To = Range("E3").Value ' Empfänger
.Display ' Mail anzeigen
.Attachments.Add "C:\Temp\Bestand_KW.xlsx"
'Ende EMail erzeugen
End With
'.send
'temporaere Datei loeschen
Kill "C:\Temp\MappeTest.xlsx"
End Sub
Hallo Andre,
mir sind noch folgende Dinge aufgefallen:
C:\Temp läuft ins Leere (bei mir)
Ich schlage daher vor, das wirkliche TEMP-Verzeichnis zu nutzen: sPfad = Environ$("Temp") & "\"
Das ist auf jeden Fall immer und überall vorhanden
.To = Range("E3").Value
Der erste Empfänger beginnt in E4. Aber man müsste ohnehin den Empfänger aus der neu erstellten Datei nehmen.
Wenn der Empfänger aus der Originaldatei genommen wird, wird immer die gleiche eMail-Adresse genommen, auch wenn ich andere Leute gefiltert habe.
Kill "C:\Temp\MappeTest.xlsx"
Es wird eine andere Datei gekillt. Nicht die erstellte BestandKW.
Da die nicht vorhanden ist, wird ein Fehler erzeugt.
viele Grüße
Karl-Heinz
Hi Karl-Heinz,
danke für die Korrekturen.