Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1584to1588
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

Per VBA Code bestimmte Zellen einer Datei schicken

Per VBA Code bestimmte Zellen einer Datei schicken
13.10.2017 23:32:23
Rene
Hallo zusammen :) ,
ich habe nun einiges in Excel gebastelt für die Arbeit.
Nun stehe ich vor etwas wo meine Erfahrung noch fehlt.
Ich habe eine Datei in der ich auch eine Zeile habe in der ich ein Fertigstellungsdatum stehen habe.
nun würde ich gerne per vba nach einem bestimmten datum (für den anfang aktueller tag) das er alle zeilen sucht in der das aktuelle datum steht und aus den gefundenen zeilen er mir bestimmte spalten als Text in die Mail einfügt:
Hier mal meine Mail funktion:
Sub email()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "test@test.com"
.CC = "test@test.com"
.BCC = "test@test.com"
.Subject = "Ready Maschinen"
.Body = "Hallo zusammen," & Chr(13) & _
"" & Chr(13) & _
"folgende Maschinen sind Ready:" & Chr(13) & _
'hier sollten alle Zeilen geschickt werden in denen in R19 bis R9999 das aktuelle Datum  _
steht.
'die Zeilen mit dem aktuellen datum soll dann Spalte C, D und E davon geschickt werden. ( _
alle spalten in einer Zeile pro Ergebnis)
.Display        'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend  _
manuell vom User!
End With
End Sub
Leider finde ich keinen Ansatz wie ich in Text einen Code mit einbinde der mir die bestimmten Zellen einträgt. Diese Suchergebnisse variieren natürlich also die Anzahl.
Vielen Dank
Grüße René

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Per VBA Code bestimmte Zellen einer Datei schicken
14.10.2017 08:09:39
Sepp
Hallo René,
wo stehen den die Daten? Vielleicht wäre eine Beispieldatei hilfreich.
Gruß Sepp

AW: Per VBA Code bestimmte Zellen einer Datei schicken
14.10.2017 09:20:54
Rene
Hallo,
Das Datum steht in Tabelle1 in R19 bis R9999 (werden ja immer mehr)
Wird in spalte R das datum gefunden können mehrere ergebnisse sein, soll von diesen Zeilen die SPalte C, D und E per Mail geschickt werden. Pro Zeile die gefunden wird eine Zeile in der Email.
Grüße REné
AW: Per VBA Code bestimmte Zellen einer Datei schicken
14.10.2017 09:30:50
Rene
Noch ein Beispiel der Datei:
Maschinentyp: Größe: Seriennummer: Fertiggestellt:
Maschine 123 1200/430 1234456 14.10.2017
Das wären in dem Fall die Daten die er nutzen sollte.
Spalte C, D und E und in R steht das fertigstellungsdatum drin.
Anzeige
AW: Per VBA Code bestimmte Zellen einer Datei schicken
14.10.2017 09:39:12
Peter(silie)
Hallo,
probiere mal den Code unten aus.
Ist nicht getestet!(habe auf dem Heimrechner kein Outlook):
Option Explicit
Private worksheet_ As Worksheet
'//Dein sub, nur etwas abgewandelt, aber im
'//großen und ganzen das gleiche
Public Sub SendEmail()
Dim outlook_ As Object
Dim mail_ As Object
Dim content_ As String
'//Worksheet Variable initialisieren
Set worksheet_ = ThisWorkbook.Sheets(1)
'//Funktion aufrufen zum holen der Daten aus Spalte R
'//und Wert der Funktion übertragen
content_ = GetContent(18)
'//Falls es nichts gegeben hat, einen alternativ text anzeigen
If conent_ = "" Then content_ = "### Keine Maschinen Bereit ###"
'//Outlook Mail initialiseren
Set outlook_ = CreateObject("Outlook.Application")
Set mail_ = outlook_.CreateItem(0)
With mail_
.To = "test@test.com"
.CC = "test@test.com"
.BCC = "test@test.com"
.Subject = "Ready Maschinen"
'//Text definieren
.Body = "Hallo zusammen," & vbCrLf & vbCrLf & _
"folgende Maschinen sind Ready:" & vbCrLf & _
content_
.Display
End With
'//Aufräumen (kann man auch weglassen)
Set mail_ = Nothing
Set outlook_ = Nothing
Set worksheet_ = Nothing
End Sub
'//Funktion zum erstellen eines Strings der die Daten enthält
Private Function GetContent(ByVal FromColumn As Long) As String
Dim range_, cell_ As Range
Dim today_ As Date
Dim temp As String
'//das heutige Datum
today_ = Date
With worksheet_
'//Range setzen
Set range_ = .Range(.Cells(19, FromColumn), .Cells(9999, FromColumn))
'//Für jede zelle in der Range
For Each cell_ In range_
'//wenn Zellwert Datum
If IsDate(cell_.Value) Then
'//Wenn Zellwert heutiges Datum
If cell_.Value = today_ Then
'//erweitere variable die den Text enthählt
'//die werte einer Zeile sind durch leerschlag getrennt
'//am ende wird ein Return eingefügt
temp = temp & .Cells(cell_.Row, 3).Value & " " & .Cells(cell_.Row, 4).Value  _
& " " & _
.Cells(cell_.Row, 5).Value & " " & cell_.Value & vbCrLf
End If
End If
Next cell_
End With
GetContent = temp
'//Aufräumen
Set cell_ = Nothing
Set range_ = Nothing
End Function

Anzeige
AW: Per VBA Code bestimmte Zellen einer Datei schicken
14.10.2017 23:03:35
Rene
Hallo Peter,
danke für den Ansatz. Habe etwas gespielt und einen Ansatz gewählt mir der ich eine ListBox fülle nach datum und diese würde ich dann senden wollen. Das macht das ganze System flexibler.
Hier mal der code zur form:
Private Sub cmdSuchen_Click()
Dim lng As Long
Dim i As Integer
Application.ScreenUpdating = False
With frmEingabe
ListBox1.Clear
Worksheets(1).Activate
i = 0
For lng = 11 To ActiveSheet.UsedRange.Rows.Count
If InStr(LCase(Cells(lng, 18).Value), LCase(TextBox1.Value)) > 0 Then
ListBox1.AddItem Cells(lng, 1).text
ListBox1.Column(0, i) = Cells(lng, 3).text
ListBox1.Column(1, i) = Cells(lng, 4).text
ListBox1.Column(2, i) = Cells(lng, 5).text
ListBox1.Column(3, i) = Cells(lng, 24).text
i = i + 1
Else
End If
Next lng
End With
Application.ScreenUpdating = True
Dim zelle As Range
Dim sBegriff As Date
If IsDate(TextBox1) Then
sBegriff = CDate(TextBox1)
Else
MsgBox "Es muss für diese Suche immer ein Datum vorhanden sein!", _
vbInformation, "Hinweis"
End If
If sBegriff = 0 Then Exit Sub
Set zelle = Worksheets(1).Columns(18) _
.Find(sBegriff, LookAt:=xlWhole)
If zelle Is Nothing Then
MsgBox "Es wurden keine Maschinen gefunden!"
End If
'Spaltenbreite festlegen
ListBox1.ColumnWidths = "30 Pt;60 Pt;100 Pt"
End Sub
und hier der Code des Email senden buttons:
Private Sub CommandButton2_Click()
'Erstellen der Email für Outlook
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "renekiesewetter@msn.com"
.CC = ""
.BCC = ""
.Subject = "Ready Maschinen"
.Body = sBody & ", " & Item
.Display        'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend  _
manuell vom User!
End With
End Sub

Dort habe ich ja das sBody welches aber nur in eine Zeile schreibt hintereinander würde gern pro Eintrag eine Zeile haben.
und habe das Problem wo ich das define für sBody einbaue ohne einen fehler zu bekommen:
Das war der Beispiel code:
Dim sBody As String
For Each Item In ListBox1.items
sBody = sBody & ", " & Item
Next
Anzeige
AW: Per VBA Code bestimmte Zellen einer Datei schicken
14.10.2017 16:23:09
Sepp
Hallo René,
ich würde das in etwa so lösen.
Sub email()
Dim objOutlook As Object, objMail As Object
Dim lngLast As Long, lngRow As Long, bolStripe As Boolean
Dim HTML As String
Dim datDateFrom As Date, datDateTo As Date

datDateFrom = Date 'Startdatum
datDateTo = Date 'Enddatum

With Sheets("Tabelle1")
  lngLast = Application.Max(19, .Cells(.Rows.Count, 18).End(xlUp).Row)
  HTML = "<BR><DIV><TABLE align=left cellspacing=0 border=0>"
  HTML = HTML & "<TR style='font-weight:700; background-color:#808080; color:#FFFFFF'><TD width=" & _
    Clng(.Cells(18, 3).Width + 35) & ">" & .Cells(18, 3) & "</TD>"
  HTML = HTML & "<TD width=" & Clng(.Cells(18, 4).Width + 35) & ">" & .Cells(18, 4) & "</TD>"
  HTML = HTML & "<TD width=" & Clng(.Cells(18, 5).Width + 35) & ">" & .Cells(18, 5) & "</TD>"
  HTML = HTML & "<TD width=" & Clng(.Cells(18, 18).Width + 35) & ">" & .Cells(18, 18) & "</TD></TR>"
  For lngRow = 19 To lngLast
    If .Cells(lngRow, 18) >= datDateFrom And .Cells(lngRow, 18) <= datDateTo Then
      HTML = HTML & "<TR style='background-color:" & IIf(bolStripe, "#DCDCDC", "#F0F0F0") & _
        ";'><TD>" & .Cells(lngRow, 3) & "</TD>"
      HTML = HTML & "<TD>" & .Cells(lngRow, 4) & "</TD>"
      HTML = HTML & "<TD>" & .Cells(lngRow, 5) & "</TD>"
      HTML = HTML & "<TD>" & .Cells(lngRow, 18) & "</TD></TR>"
      bolStripe = Not bolStripe
    End If
  Next
  HTML = HTML & "</TABLE></DIV><BR>"
End With

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
  .to = "test@test.com"
  .CC = "test@test.com"
  .BCC = "test@test.com"
  .Subject = "Ready Maschinen"
  .HTMLBody = "Hallo zusammen,<BR><BR>folgende Maschinen sind Ready:<BR>" & HTML
  .Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend _
    manuell vom User!

End With

Set objOutlook = Nothing
Set objMail = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Per VBA Code bestimmte Zellen einer Datei schicken
15.10.2017 01:23:12
Rene
Hallo Sepp,
das geht echt richtig gut.
Ich habe allerdings etwas getestet und manchmal muss man auch Maschinen mit einem anderen Datum senden wenn man dies nicht immer gleich schickt.
Habe mir eine Form gebaut mit der ich Suche und dann gefundene Maschinen schicken möchte.
Das Design durch das HTML ist echt top. Jede Zeile anders abwechslend ist echt top und man erkennt alles.
Kannst du evtl. helfen deins mit meinem bisherigen code zu erweitern?
Hier mein Form code zum suchen und anzeigen:
Private Sub cmdSuchen_Click()
Dim lng As Long
Dim i As Integer
Application.ScreenUpdating = False
With frmEingabe
ListBox1.Clear
Worksheets(1).Activate
i = 0
For lng = 11 To ActiveSheet.UsedRange.Rows.Count
If InStr(LCase(Cells(lng, 18).Value), LCase(TextBox1.Value)) > 0 Then
ListBox1.AddItem Cells(lng, 1).text
ListBox1.Column(0, i) = Cells(lng, 3).text
ListBox1.Column(1, i) = Cells(lng, 4).text
ListBox1.Column(2, i) = Cells(lng, 5).text
ListBox1.Column(3, i) = Cells(lng, 24).text
i = i + 1
Else
End If
Next lng
End With
Application.ScreenUpdating = True
Dim zelle As Range
Dim sBegriff As Date
If IsDate(TextBox1) Then
sBegriff = CDate(TextBox1)
Else
MsgBox "Es muss für diese Suche immer ein Datum vorhanden sein!", _
vbInformation, "Hinweis"
End If
If sBegriff = 0 Then Exit Sub
Set zelle = Worksheets(1).Columns(18) _
.Find(sBegriff, LookAt:=xlWhole)
If zelle Is Nothing Then
MsgBox "Es wurden keine Maschinen gefunden!"
End If
'Spaltenbreite festlegen
ListBox1.ColumnWidths = "30 Pt;60 Pt;100 Pt"
End Sub
hier der code zum email senden:
Private Sub CommandButton2_Click()
'Erstellen der Email für Outlook
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "renekiesewetter@msn.com"
.CC = ""
.BCC = ""
.Subject = "Ready Maschinen"
.Body = sBody & ", " & Item
.Display        'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend  _
manuell vom User!
End With
End Sub
Allerdings habe ich probleme das sBody zu definieren. am liebsten wäre es mir mit deinem HTML format. Es müssten die angezeigten ListBox ergebnisse senden.
Hier der Code den ich gefunden hatte zum auslesen der ListBox aber nicht ganz weiß wo ich ihn einbauen soll:
Dim sBody As String
For Each Item In ListBox1.items
sBody = sBody & ", " & Item
Next
Anzeige
AW: Per VBA Code bestimmte Zellen einer Datei schicken
15.10.2017 08:48:26
Sepp
Hallo René,
das ist aber eine völlig andere Aufgabe! Warum stellst du nicht gleich die Frage so, das man mit einer Lösung das Ziel erreicht. Für die neue Aufgabe muss eine komplett neue Lösung erstellt werden.
Ohne deine Datei mit dem UserForm wird das nichts, denn keiner wird Lust haben deine Datei nachzubauen.
Gruß Sepp

AW: Per VBA Code bestimmte Zellen einer Datei schicken
15.10.2017 10:39:31
Rene
Hallo Sepp,
ja sorry habe eben damit gearbeitet und dann habe ich gemerkt was ist wenn ich einen Tag das mal vergesse dann wäre es einfacher mit einer Form.
Meine Datei kann ich leider nicht schicken da viele Firmensachen drin sind.
Ich ziehe mal das zeug welches ich brauche eben raus und lade diese hoch :)
https://www.herber.de/bbs/user/116967.xlsm
Anzeige
AW: Per VBA Code bestimmte Zellen einer Datei schicken
15.10.2017 13:44:28
Rene
Hallo Sepp,
der Hammer es funktioniert echt super.
Hätte da noch eine kleine Frage.
Du siehst ja das ich in Spalte M einen Status habe 0 ist Rot 1 ist gelb und 2 ist grün.
Kann man das auch noch machen das sich der Text der Maschinen Also Typ und Größe in die jweilige Farbe färben in der Email ?
Das wäre dann der Hammer, dann müsste ich das nicht auch extra machen immer.
Anzeige
AW: Per VBA Code bestimmte Zellen einer Datei schicken
15.10.2017 16:59:41
Rene
Hallo Sepp,
vielen vielen dank. Der Hammer wie mit wenig zeilen code in vba man soviel mit excel erleichtern kann.
Hast du einen Typ über Tutorials usw evtl. ?
Ich würde das ganze wirklich auch gerne besser lernen.
Damit erleichtert man sich den Alltag um so einiges :)
Und du solltest auf jedenfall deine VBA Kenntnis von bescheiden ändern im Profil. Das ist nicht der Fall :)
Anzeige
AW: Per VBA Code bestimmte Zellen einer Datei schicken
15.10.2017 17:03:32
Sepp
Hallo René,
Tutorials kann ich keine empfehlen, aber das Netz ist voll von Seiten zu Excel/VBA.
Zum Level: Das ist der Level den du angegeben hast!
Gruß Sepp

AW: Per VBA Code bestimmte Zellen einer Datei schicken
18.10.2017 16:07:30
René
Servus Sepp,
Achso das zieht sich durch.
Ich habe mir eine 2te Form gebaut um eben auch einen status per mail zu erfragen von Roten Maschinen
Code sieht so aus:
Option Explicit
Private Sub cmdSuchen_Click()
Dim lngRow As Long, lngLast As Long
If TextBox1.text  "" Then
With Sheets("Maschinenliste")
lngLast = Application.Max(19, .Cells(.Rows.Count, 1).End(xlUp).Row)
ListBox1.Clear
For lngRow = 19 To lngLast
If .Cells(lngRow, 5).Value = TextBox1 Then
ListBox1.AddItem Cells(lngRow, 1).text
ListBox1.Column(0, ListBox1.ListCount - 1) = .Cells(lngRow, 3).text
ListBox1.Column(1, ListBox1.ListCount - 1) = .Cells(lngRow, 4).text
ListBox1.Column(2, ListBox1.ListCount - 1) = .Cells(lngRow, 5).text
ListBox1.Column(3, ListBox1.ListCount - 1) = .Cells(lngRow, 24).text
ListBox1.Column(4, ListBox1.ListCount - 1) = .Cells(lngRow, 13).Value
End If
Next
End With
Else
MsgBox "Kein gültige Seriennummer!"
End If
End Sub

Private Sub CommandButton2_Click()
'Erstellen der Email für Outlook
Dim objOutlook As Object, objMail As Object
Dim lngIndex As Long, HTML As String, bolStripe As Boolean, strColor As String
With ListBox1
If .ListCount > 0 Then
HTML = _
"
" HTML = HTML & _ "" HTML = HTML & "" HTML = HTML & "" For lngIndex = 0 To .ListCount - 1 Select Case .List(lngIndex, 4) Case "0": strColor = "red" Case "1": strColor = "#e6e600" Case "2": strColor = "green" Case Else: strColor = "#000000" End Select HTML = HTML & "" HTML = HTML & "" HTML = HTML & "" HTML = HTML & "" bolStripe = Not bolStripe Next HTML = HTML & "
Typ:" HTML = HTML & "Größe:Seriennummer:Bemerkung:
" & .List(lngIndex, 0) & "" & .List(lngIndex, 1) & "" & .List(lngIndex, 2) & "" & .List(lngIndex, 3) & "

Else MsgBox "Keine Maschinendaten vorhanden!" End If End With If Len(HTML) Then Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) With objMail .To = "markus.schindler@haitiangermany.com" .CC = "" .BCC = "rene.kiesewetter@haitiangermany.com" .Subject = "Maschinenstatus" .HTMLBody = "Hallo zusammen,

wie ist der Status folgender Maschine ? :
" & HTML _ & "
Grüße " & "
" & Application.UserName .Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend _ manuell vom User! End With End If Set objOutlook = Nothing Set objMail = Nothing End Sub

Private Sub CommandButton3_Click()
TextBox1.Value = ""
ListBox1.Clear
End Sub

Private Sub Label14_Click()
End Sub

Private Sub Label27_Click()
End Sub

Private Sub ListBox1_Click()
End Sub
'Zentrieren auf beiden Bildschirmen des Fenstern
Private Sub UserForm_Initialize()
Dim sngTop As Single, sngLeft As Single
Me.StartUpPosition = 0
sngLeft = Application.Left + Application.Width / 2 - Me.Width / 2
sngTop = Application.Top + Application.Height / 2 - Me.Height / 2
Me.Left = sngLeft
Me.Top = sngTop
Label13 = Date
Label28 = Time
'Spaltenbreite festlegen
ListBox1.ColumnCount = 5
ListBox1.ColumnWidths = "30 Pt;60 Pt;100 Pt;100 Pt;0 Pt"
End Sub

Gibt es eine Möglichkeit dafür in den Email Betreff z.B. Maschinenstatus von Typ Größe Seriennumer automatisch anhängen zu lassen.
im der tabelle ist ja dann Typ Größe Seriennummer und Bemerkung nun drin.
Nur der Einheit halber haben wir im Unternehmen zum schnellen finden immer im Betreff auch den Typ die Größe und die Seriennummer drin.
Vielen Dank
Grüße René
Anzeige

310 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige