Erste freie Zelle für Mailbody

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Erste freie Zelle für Mailbody
von: Andreas
Geschrieben am: 20.11.2015 14:07:15

Hallo,
ich habe mir einen Code zusammensucht und gebastelt, mit dem eine Mail erstellt wird und ein bestimmter Bereich als Text eingefügt wird. Nun möchte ich gerne die letzte freie Zelle für diesen Bereich bestimmen (es sollen nicht so viel freie Zellen mit in die Mail), eigentlich ja simpel, funktioniert nur nicht...
Hier mein aktueller Text


'Funktion für Mailbody'
Private Function fncRangeToHtml(strWorksheetname As String, _
    strRangeaddress As String) As String
    Dim objFilesytem As Object, objTextstream As Object
    Dim strFilename As String
    strFilename = Environ$("temp") & "/" & _
        Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
     ActiveWorkbook.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
        Filename:=strFilename, _
        Sheet:=strWorksheetname, _
        Source:=strRangeaddress, _
        HtmlType:=xlHtmlStatic).Publish True
    Set objFilesytem = CreateObject("Scripting.FileSystemObject")
    Set objTextstream = objFilesytem.GetFile(strFilename). _
        OpenAsTextStream(1, -2)
    fncRangeToHtml = objTextstream.ReadAll
    objTextstream.Close
    Set objTextstream = Nothing
    Set objFilesytem = Nothing
    Kill strFilename
End Function
Private Sub Commandbutton1_Click()
       'Email erstellen'
        
          Set olApp = CreateObject("Outlook.Application")
    With olApp.CreateItem(0)
              .GetInspector
              .To = ""
              .CC = ""
              .Subject = "COB / " & Sheets("DATA").Range("B12").Text & " / " & Sheets("DATA"). _
Range("B8").Text & " / " & Sheets("DATA").Range("B1").Text & " / " & Sheets("DATA").Range("B11").Text
              .htmlBody = fncRangeToHtml("Tab1", "A1:F35") & .htmlBody
              .Attachments.Add strPfad & DatNam
              .Display
      End With
End Sub
Diese Funktion läuft so wie oben gut, ich hatte gedacht ich könnte das Problem wie folgt lösen:
Dim LetzteZeile As Long
L = Worksheets("Tab1").Range("F1").End(xlDown).Row
Und dann
.htmlBody = fncRangeToHtml("Tab1", "A1:F" & LetzteZeile) & .htmlBody
Kann mir jemand sagen, warum das nicht funktioniert und wie es funktionieren kann?
Dankeschön!

Bild

Betrifft: AW: Erste freie Zelle für Mailbody
von: Michael (migre)
Geschrieben am: 20.11.2015 14:24:37
Hallo Andreas!
Quick-and-dirty, ohne groß zu testen, versuch mal so:

Private Sub Commandbutton1_Click()
       'Email erstellen'
        
        Dim Bereich As String
        
        With Worksheets("Tab1")
            Bereich = "A1:F" & .Cells(.Rows.Count, 6).Row
        End With
        
          Set olApp = CreateObject("Outlook.Application")
    With olApp.CreateItem(0)
              .GetInspector
              .To = ""
              .CC = ""
              .Subject = "COB / " & Sheets("DATA").Range("B12").Text & " / " & Sheets("DATA").  _
_
Range("B8").Text & " / " & Sheets("DATA").Range("B1").Text & " / " & Sheets("DATA").Range("B11") _
.Text
              .htmlBody = fncRangeToHtml("Tab1", Bereich) & .htmlBody
              .Attachments.Add strPfad & DatNam
              .Display
      End With
End Sub
LG
Michael

Bild

Betrifft: AW: Erste freie Zelle für Mailbody
von: Andreas
Geschrieben am: 20.11.2015 14:55:47
Hat leider nicht funktioniert.
Er schmeißt mir keinen Error raus, es wird aber immer noch die komplette Tabelle mit reinkopiert. Ich glaube aber fast, ich weiß woran es liegen könnte.
Die Zellen sind mit Formeln befüllt, Wenn...dann "", sonst....
Das heißt, sie sind befüllt, weisen nur keinen Wert auf, vielleicht hilft das weiter?

Bild

Betrifft: AW: Erste freie Zelle für Mailbody
von: Andreas
Geschrieben am: 20.11.2015 15:08:32
Nein, kann damit auch nichts zu tun haben. Ich habe gerade mal die Formeln rausgelöscht, und es wird immer noch die komplette Tabelle in die Email eingefügt.
Bis Zeile 35. Ich frage mich, wo das jetzt definiert ist?

Bild

Betrifft: AW: Richtig, Zellen mit Formel sind nicht leer...
von: Michael (migre)
Geschrieben am: 20.11.2015 15:13:55
Andreas,
Wie Du richtig erkannt hast. Du müsstest dann zB den Bereich nur als Werte kopieren und anderswo einfügen und dann darauf zugreifen für die Email. Andere Workarounds sind denkbar, aber ich bin nicht mehr vorm Rechner und kann daher nicht helfen.
Ich stell Dich auf offen...
LG
Michael

Bild

Betrifft: AW: Code geputzt und funktioniert
von: Michael (migre)
Geschrieben am: 23.11.2015 08:25:49
Hallo Andreas!
Bin nochmal über Deinen Code gegangen und habe diesen nochmal etwas angepasst - funktioniert so aus meiner Sicht, auch bei Formel-Zellinhalten werden nur die "sichtbaren" Werte in den Email-Text übernommen.

Private Function fncRangeToHtml(strWorksheetname As String, strRangeaddress As String) As  _
String
    
    Dim objFilesytem As Object
    Dim objTextstream As Object
    Dim strFilename As String
    
    strFilename = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
     
     ActiveWorkbook.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
        Filename:=strFilename, _
        Sheet:=strWorksheetname, _
        Source:=strRangeaddress, _
        HtmlType:=xlHtmlStatic).Publish True
    
    Set objFilesytem = CreateObject("Scripting.FileSystemObject")
    
    Set objTextstream = objFilesytem.GetFile(strFilename). _
        OpenAsTextStream(1, -2)
    
    fncRangeToHtml = objTextstream.ReadAll
    
    objTextstream.Close
    
    Set objTextstream = Nothing
    Set objFilesytem = Nothing
    
    Kill strFilename
    
End Function
Private Sub Commandbutton1_Click()
    Dim olApp As Object
    Dim ws As Worksheet
    Dim strBlatt As String
    Dim strBereich As String
    Set olApp = CreateObject("Outlook.Application")
    Set ws = Worksheets("Tab1")
    
    With ws
        strBlatt = .Name
        strBereich = .Range("A1:F" & .Cells(.Rows.Count, 6).End(xlUp).Row).Address
    End With
    
    With olApp.CreateItem(0)
        '.GetInspector
        .To = ""
        .CC = ""
        .Subject = "Whatever"
        .htmlBody = fncRangeToHtml(strBlatt, strBereich)
        '.Attachments.Add strPfad & DatNam
        .Display
    End With
      
End Sub
LG
Michael

Bild

Betrifft: AW: Code geputzt und funktioniert
von: Andreas
Geschrieben am: 23.11.2015 09:58:17
Moin Michael,
fast...der Code läuft, allerdings wird immer noch der komplette Tabellenbereich in die Mail übernommen.
Allerdings funktioniert es jetzt, wenn ich manuell die Formeln aus den Zellen lösche.
Das heißt, es würde wahrscheinlich reichen, wenn man nicht nach der ersten freien Zelle sucht, sondern nach der ersten mit einem Wert unter 1!?
Ich bin im dem Bereich leider nicht so fit, nur eine Idee, da Excel ja anscheinend eine 0 bzw. "" nicht als leere Zelle bewertet.
Danke für deine Hilfe und Gruß
Andreas

Bild

Betrifft: AW: Ich glaube wir sprechen aneinander vorbei...
von: Michael (migre)
Geschrieben am: 23.11.2015 11:43:02
Hallo Andreas!
wird immer noch der komplette Tabellenbereich in die Mail übernommen
Kannst Du mir mal ein Beispiel Deiner Tabelle hochladen, wobei Du bitte aufzeigst, wie groß der Tabellenbereich ist und welche Teile davon tatsächlich in die Email gelangen sollen?
LG
Michael

Bild

Betrifft: AW: Ich glaube wir sprechen aneinander vorbei...
von: Andreas
Geschrieben am: 23.11.2015 12:30:13
Hallo Michael,
Nein, ich kann dir leider nicht die komplette Datei anhängen, da sehr viele firmeninterne Daten verarbeitet sind, die ich nicht mal eben schnell rauslöschen kann.
Habe dir jetzt nur das genannte Blatt angehangen, dass du dir in etwa vorstellen kannst, wie es aussieht.
Mit dem Code wird immer der Bereich A1:F61 in den Mail Body übertragen, ganz gleich ob ein Wert oder nicht in der Zelle ist.
Wenn ich z.B. ab Zeile 34 die Formeln löschen, wird auch nur der Bereich bis Zeile 34 in den Mail Body übertragen. Das funktioniert dann soweit.
https://www.herber.de/bbs/user/101744.xlsx
Hoffe, das hilft weiter.
Gruß

Bild

Betrifft: AW: So...
von: Michael (migre)
Geschrieben am: 23.11.2015 13:59:30
Hallo Andreas!
Nein, ich kann dir leider nicht die komplette Datei anhängen
Das wollte ich auch nicht; ich wollte nur ein Beispiel des Bereichs und was davon dann übertragen bzw. nicht übertragen werden soll.
Mit dem Code wird immer der Bereich A1:F61 in den Mail Body übertragen, ganz gleich ob ein Wert oder nicht in der Zelle ist.
Dann suchen wir uns also die erste optisch leere Zelle in Spalte F; also jene (erste) Zelle deren Wert "" ist - d.h. die Zelle darüber ist unser Bereichsende in F.
Hier der neue Code für den Command Button, die Function (fncRangeToHtml) bleibt unverändert:

  Private Sub Commandbutton1_Click()
  
      Dim olApp As Object
      Dim ws As Worksheet
      Dim strBlatt As String
      Dim strBereich As String
      Dim rngFinden As Range
      Dim lngEnde As Long
  
      Set olApp = CreateObject("Outlook.Application")
      Set ws = Worksheets("Tab1")
      
      'Letzte optisch gefüllte Zeile in Spalte F
      With ws
          strBlatt = .Name
          
          With .Range("F:F") 'Suchespalte anpassen
            Set rngFinden = .Find("", LookIn:=xlValues)
            If Not rngFinden Is Nothing Then lngEnde = rngFinden.Row - 1
          End With
          
          strBereich = .Range("A1:F" & lngEnde).Address
      End With
      
      With olApp.CreateItem(0)
          '.GetInspector
          .To = ""
          .CC = ""
          .Subject = "Whatever"
          .htmlBody = fncRangeToHtml(strBlatt, strBereich)
          '.Attachments.Add strPfad & DatNam
          .Display
      End With
        
  End Sub
Klappt?
LG
Michael

Bild

Betrifft: AW: So...
von: Andreas
Geschrieben am: 23.11.2015 14:23:39
Es funktioniert!!!
Super, vielen vielen Dank für deine Hilfe, Michael!

Bild

Betrifft: AW: Gerne, freut mich! Danke f.d. Rückmeldung owT
von: Michael (migre)
Geschrieben am: 23.11.2015 15:13:18


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bedingte Formatierung etwas komplexer"