Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1456to1460
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Erste freie Zelle für Mailbody

Erste freie Zelle für Mailbody
20.11.2015 14:07:15
Andreas
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!

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Erste freie Zelle für Mailbody
20.11.2015 14:24:37
Michael
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

Anzeige
AW: Erste freie Zelle für Mailbody
20.11.2015 14:55:47
Andreas
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?

AW: Erste freie Zelle für Mailbody
20.11.2015 15:08:32
Andreas
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?

AW: Richtig, Zellen mit Formel sind nicht leer...
20.11.2015 15:13:55
Michael
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

Anzeige
AW: Code geputzt und funktioniert
23.11.2015 08:25:49
Michael
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

Anzeige
AW: Code geputzt und funktioniert
23.11.2015 09:58:17
Andreas
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

AW: Ich glaube wir sprechen aneinander vorbei...
23.11.2015 11:43:02
Michael
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

Anzeige
AW: Ich glaube wir sprechen aneinander vorbei...
23.11.2015 12:30:13
Andreas
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ß

Anzeige
AW: So...
23.11.2015 13:59:30
Michael
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

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

AW: Gerne, freut mich! Danke f.d. Rückmeldung owT
23.11.2015 15:13:18
Michael

52 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige