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 & _
"Typ:"
HTML = HTML & " | Größe: | "
HTML = HTML & "Seriennummer: | "
HTML = HTML & "Bemerkung: |
"
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 & "" & .List(lngIndex, 0) & " | "
HTML = HTML & "" & .List(lngIndex, 1) & " | "
HTML = HTML & "" & .List(lngIndex, 2) & " | "
HTML = HTML & "" & .List(lngIndex, 3) & " |
"
bolStripe = Not bolStripe
Next
HTML = HTML & "
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é