Geänderte Daten per EMail versenden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Franz,
über dein Vorschlag habe ich auch mal nachgedacht. Jedoch ist dies für unseren Bereich nicht sehr praktikabel, da mehrere User verschiedene Daten bearbeiten und die Mail zuerst an ein Sammelmail verschickt wird. Von dort aus werden die Mails weitergeleitet. Daher muss bei jeder Erfassung eine Email mit dem "einen" Datensatz verschickt werden, und das mehrmals am Tag.
Ich poste mal ein Beispieldatei. Vielleicht wird es besser verständlicher.
Zuerst aber mal der Code, der das Speichern auslöst und hier soll auch der Code mit dem Email hin:

Private Sub EINTRAG_SPEICHERN()
Dim lZeile As Long
Dim i As Integer
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = ListBox1.List(ListBox1.ListIndex, 0)
For i = 1 To iCONST_ANZAHL_EINGABEFELDER
ActiveSheet.Cells(lZeile, i + 1) = Me.Controls("TextBox" & i)
Next i
'Der Benutzer könnte die angezeigten Werte in der Liste geändert haben,
'daher aktualisieren wir den ausgewählten Eintrag entsprechend.
ListBox1.List(ListBox1.ListIndex, 1) = TextBox1
ListBox1.List(ListBox1.ListIndex, 2) = TextBox2
ListBox1.List(ListBox1.ListIndex, 3) = TextBox3
MsgBox "Änderung übernommen", vbInformation
'''JETZT SOLLEN DIE DATEN NEUEN BZW. GEÄNDERTEN KOPIERT UND IN EMAIL EINGEFÜGT/VERSENDET  _
WERDEN!
'ActiveWorkbook.Save    'Speichert nach jeder eingabe
End Sub

Und diesen Code habe ich gefunden, was meinen Bedürfnissen entsprechen würde. Das Problem ist jedoch, ich kann nur einen bestimmten Zellbereich hier auswählen und nicht tatsächlich die Daten die ich will. Ich denke, wenn ich anstatt den Zellbereich eine Variable definiere (hier im Code;.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Range("A1:E12"))) wo ich die Daten die übertragen wurden übergeben kann, könnte es gehen, oder?!

Option Explicit
Public Sub TableToMail()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.to = "Test@Test.aa"
.Subject = "ÄNDERUNG " & CStr(Date)
.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Range("A1:E12"))
.Display    'nur Anzeigen
'        .Send       'direkt senden
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
Private Function RangeToHTML(objSheet As Worksheet, objRange As Range) As String
Dim strFilename As String
strFilename = Environ$("TEMP") & "/" & Format(Now, "dd-mm-yyyy_hh-mm-ss") & ".htm"
ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=objSheet.Name, _
Source:=objRange.Address, _
HtmlType:=xlHtmlStatic).Publish True
RangeToHTML = CreateObject("Scripting.FileSystemObject"). _
GetFile(strFilename).OpenAsTextStream(1, -2).ReadAll
Kill strFilename
End Function

Hier die Datei:
https://www.herber.de/bbs/user/121048.xls

' letzte Zelle in Range (linksoben) => das ist die erste Zelle die ins Email soll. ActiveSheet.Cells(lZeile, i + 1).Select LinksOben = ActiveCell.Address ' werte für test setzen i = i + iCONST_ANZAHL_EINGABEFELDER 'Hier schaltest Du durch die Zeile ' letzte zelle in Range (rechtsunten) => das ist die letzte Zelle die ins Email soll. ActiveSheet.Cells(lZeile, i + 1).Select RechtsUnten = ActiveCell.Address ' Range als STRING zusammensetzen xRange = LinksOben & ":" & RechtsUnten

Hi,
danke nochmal für die Erklärung, aber der Code passt irgendwie doch nicht .
Du hast mich jedoch mit "xlRange" auf eine Idee gebracht, den ich auch umgesetzt habe und es klappt damit sowie ich es mir vorstelle. Ein problem blebt aber dennoch.
Erst was ich gemacht habe:
Der Code den ich auffinden konnte sah so aus:

.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Range("A1:E12"))

Damit konnte ich jedoch immer nur einen bestimmten Bereich zur Email importieren.
Ich habe ja in meinem Code die Variable "lZeile". Habe .Range... ersetzt mit:

.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Rows(lZeile))

Nun erscheinen die Zeilen, die ich bearbeitet oder neuangelegt habe in meinem Email. Jedoch ist de Ansicht ganz komisch. Die Spalten sind zwar nebeneinander, aber erscheinen wie im Blocksatz, sodass das lesen sehr mühsam ist. In der Excel Tabelle ist dies nicht so.
Wenn ich aber den Code unverändert, also


.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Range("A1:E12"))

, ausführe ist alles OK, aber halt nicht die Zeilen die ich will!
Wie kann ich das jetzt lösen, dass die Zeilen im Email wie im xls erscheinen?
Gruß
Naki

xGesamtDatei = "SchulungsplanDaten_per_" & Format((Now), "YYYYMMDD-hhmmss") Workbooks.Add ActiveWorkbook.SaveAs Filename:=xGesamtDatei Set WBgesamt = ActiveWorkbook WBgesamt.Sheets(1).Name = "ALLE_per_" & Format((Now), "YYYYMMDD-hhmmss")

Public Sub TableRangeToMail() Dim objOutlook As Object Dim objMail As Object Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) Dim lZeile As Long Dim sAttName As String ' werte für test setzen lZeile = 2 sAttName = VBA.Environ("Temp") & "\" & "ÄNDERUNG " _ & Format(Now, "YYYY-MM-DD hh_mm_ss") & ".xlsx" If fncMakeAttachment(strAttachmentName:=sAttName, wks:=ActiveSheet, _ Zei1:=lZeile, Zei2:=lZeile, Spa1:=1, Spa2:=5) = True Then With objMail .to = "test.test@gibts.nicht" .Subject = "ÄNDERUNG " & CStr(Date) .Attachments.Add sAttName .Display 'nur Anzeigen ' .Send 'direkt senden End With End If If Dir(sAttName) "" Then VBA.Kill sAttName Set objMail = Nothing Set objOutlook = Nothing End Sub Private Function fncMakeAttachment(strAttachmentName As String, wks As Worksheet, _ Zei1 As Long, Zei2 As Long, _ Spa1 As Long, Spa2 As Long) As Boolean 'wks = Tabellenblatt mit den zu sendenden Daten 'strAttachmentName = Pfad+Name des Attachments 'Zei1, Zei2, Spa1,Spa2'Zeilen/Spaltenbereich der übernommen werden soll Dim wkb As Workbook, rng As Range, wksAtt As Worksheet On Error GoTo Fehler Set wkb = Application.Workbooks.Add(Template:=xlWBATWorksheet) Set wksAtt = wkb.Worksheets(1) With wks Set rng = .Range(.Cells(Zei1, Spa1), .Cells(Zei2, Spa2)) End With With wksAtt rng.Copy .Range("A1").PasteSpecial xlPasteColumnWidths .Range("A1").PasteSpecial xlPasteFormats .Range("A1").PasteSpecial xlPasteValues .Name = "Änderung" End With wkb.SaveAs Filename:=strAttachmentName, FileFormat:=51 ' wkb.Close False Fehler: With Err Select Case .Number Case 0 fncMakeAttachment = True Case Else fncMakeAttachment = False MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbOKOnly, _ "Makro: fncMakeAttachment" End Select End With End Function

Beliebteste Forumthreads (12 Monate)

Geänderte Daten per EMail versenden

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

320 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Geänderte Daten per EMail versenden

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

320 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread