Sendmail mit Bedingung

Hallo Forummitglieder,
habe folgende Problemstellung, villeicht könnt ihr mir weiterhelfen oder einen Tipp geben.
Habe eine Excel-Tabelle mit mehreren Arbeitsblättern die ähnlich aufgebaut sind.
https://www.herber.de/bbs/user/81393.xlsm
Die Zellen in der Zeile 3 in jeder Arbeitsmappe sind bedingt formatiert. Wenn Datum in der Zeile 3 kleiner als in der Zeile 2 ist soll die Zelle pink erscheinen.
Möchte gerne ein Script oder ein Macro erstellen, was beim Speichern der Datei prüft, ob in einer der Arbeitsmappen diese Bedingung vorliegt, falls ja, sollte eine Mail versendet werden. Entweder mit der kompletten Excel-Datei (was eigentlich nicht unbedingt schön ist, da die Datei mehrere MB groß ist), nur einer Arbeitsmappe in der die Bedingung erfüllt ist, oder nur mit einem Hinweis in der E-Mail-Betreffzeile ohne Excel-Datei.
Ist überhaupt sowas realisierbar? Oder ist es zuviel Aufwand?
Vielen Dank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Waldemar,
in das Modul "DieseArbeitsmappe", als Mail-Programm hab ich mal Outlook vorausgesetzt.

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeC() 'lose(Cancel As Boolean)
  Dim objSh As Worksheet, objOL As Object
  Dim lngLast As Long, lngIndex As Long
  Dim strBody As String, strTmp As String
  
  For Each objSh In Me.Worksheets
    With objSh
      lngLast = Application.Max(3, .Cells(2, .Columns.Count).End(xlToLeft).Column)
      For lngIndex = 3 To lngLast
        If .Cells(2, lngIndex) > .Cells(3, lngIndex) Then
          strTmp = RangeToHTML(objSh, objSh.Range(.Cells(2, 1), .Cells(3, lngLast)))
          strBody = strBody & "<div style='border:1px solid #000000; padding:5px; margin:0px 0px 5px 0px;'><strong style='font-size:14pt;'>" & _
            .Name & "</strong><br/>" & strTmp & "<br/></div>"
          Exit For
        End If
      Next
    End With
  Next
  
  If Len(strBody) Then
    Set objOL = CreateObject("Outlook.Application")
    
    With objOL.CreateItem(0)
      .GetInspector.Display
      .Importance = 1
      .To = "try.to@guess.it" 'Empfänger
      .Cc = ""
      .Bcc = ""
      .Subject = "Betreff"  'Betreff
      .HTMLBody = "<div>Hallo!<br/>zur Kontrolle.</div><br/>" & strBody & .HTMLBody
      .Display 'oder .Send um diekt zu versenden
    End With
  End If
  
  Set objOL = Nothing
End Sub


Private Function RangeToHTML(objSheet As Worksheet, objRange As Range) As String
  Dim strFilename As String
  
  strFilename = Environ$("TEMP") & "/temp.htm"
  
  objSheet.Parent.PublishObjects.Add(SourceType:=xlSourceRange, Filename:=strFilename, _
    Sheet:=objSheet.Name, Source:=objRange.Address, HtmlType:=xlHtmlStatic).Publish True
  
  RangeToHTML = _
    Replace(CreateObject("Scripting.FileSystemObject").GetFile(strFilename).OpenAsTextStream(1, _
    -2).ReadAll, "align=center x:publishsource=", "align=left x:publishsource=")
  
  Kill strFilename
End Function

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Sendmail mit Bedingung

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread