Emailgenerator macht nicht was er soll
27.02.2020 13:37:15
Markus
ich habe neulich ein Makro geschrieben, bei dem eine Tabelle als eine Art Fehlersammelliste fungieren soll und die Leute automatisch eine Email kriegen sollen, wenn der Termin nicht eingehalten ist. (Ich muss dazu auf einen Emailbutton klicken). Jetzt hatte ich ein Problem, dass, wenn ich auf den button geklickt habe, 25 oder 50 Emails versendet wurden (Wahrscheinlich hat er aus jeder Zeile in der Tabelle einen eintrag versendet, was aber eigentlich nicht sein konnte, weil nur ein einziges Feld einen Inhalt hatte und das war das gleiche bei den 50 Mails). Nun habe ich noch ein paar Ergänzungen gemacht, dass das nicht mehr der Fall ist. Eben habe ich das noch einmal probiert und in meiner Tabelle aktuell10 Einträge, von denen 3 die Kriterien erfüllen. Er wollte mir auch nur 3 Emails senden, was gut ist, aber ich habe nur in einer Zeile meinen Namen eingetragen und trotzdem will er alle Emails an mich senden. Vielleicht kann sich das von euch einmal jemand anschauen und mir sagen, wo der Hund begraben liegt. Ich möchte vermeiden, wenn ich das Makro wieder scharf schalte, dass sich meine Kollegen beschweren, dass sie alles doppelt und dreifach kriegen.
Ich danke euch Vorab. :)
MFG Markus
Option Explicit
Private Sub Email_Click()
Dim mailadresse As String
Dim datum As Date
Dim bereich As Range
Dim zelle As Range
Dim Datsoll As Date
Dim letztezeile As Integer
Dim verantwortlich As String
Dim person1 As String
Dim person2 As String
Dim person3 As String
Dim kopie As Range
Dim objOutlook As Object
Dim objMail As Object
Dim objWorksheet As Worksheet
Dim i As Integer
letztezeile = Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set bereich = Range(Cells(2, 1), Cells(letztezeile, 1))
heute = Date
If Environ("Username") = "qsig09" Then
For Each zelle In bereich
If zelle.Value "" Then
If zelle.Offset(0, 11).Value - 5 Private Function RangeToHTML(ByRef probjSheet As Worksheet, ByRef probjRange As Range) As _
String
Const ForReading As Long = 1
Const TristateUseDefault As Long = -2
Dim strFilename As String
Dim objPublishObject As PublishObject
Dim objFileSystemObject As Object
Dim objFile As Object
Dim objTextStream As Object
strFilename = Environ$("TMP") & "/" & Format$(Now, "dd-mm-yyyy_hh-mm-ss") & ".htm"
Set objPublishObject = ThisWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=probjSheet.name, _
Source:=probjRange.Address, _
HtmlType:=xlHtmlStatic)
Call objPublishObject.Publish(Create:=True)
Set objFileSystemObject = CreateObject(Class:="Scripting.FileSystemObject")
Set objFile = objFileSystemObject.GetFile(strFilename)
Set objTextStream = objFile.OpenAsTextStream(ForReading, TristateUseDefault)
RangeToHTML = objTextStream.ReadAll
Call objTextStream.Close
Call Kill(PathName:=strFilename)
RangeToHTML = Replace$(RangeToHTML, "align=center", "align=left")
Set objPublishObject = Nothing
Set objTextStream = Nothing
Set objFile = Nothing
Set objFileSystemObject = Nothing
End Function