PDA

Vollständige Version anzeigen : Email Absender in Tabelle speichern?


walpla
24.07.2012, 20:02
Hallo VBA Profis!

mal ein nettes Hallo von einem VBA Neuling!

Dank Euren vielen Beiträgen und Vorschlägen, habe ich an einer Personaldatei großartiges zusammen gebracht! Ich stelle sie nachher auch hier rein, weil einige vielleicht daraus lernen können!

Ich hätte noch eines gerne gelöst, werde aber leider nicht fündig!

Eine Userform speichert Daten in eine fortlaufende Tabelle und in einem Formular, das Formular wird mit folgendem Code an mehrere Empfänger versendet:

Sheets("Krank-Gesund").Select

Range("B4:G19").Select

Dim strEmail As String

strEmail = Range("A1").Value

With Selection
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Item.Subject = "Krank-Gesundmeldung"
.Item.To = strEmail
.Item.Send
End With
End With
ActiveWorkbook.EnvelopeVisible = False


Sheets("Krank-Gesund").Select
Range("A7").Select

Klappt auch wunderbar!

Nur arbeiten mehrere Kollegen (mit verschiedenen Mailadressen)mit dieser Datei und ich würde gerne die Mailadresse vom Absender in der Tabelle abspeichern!(Damit weiß man, wer das Mail verschickt hat)

Habt ihr eine Idee dazu?

Vielen Dank schon im Voraus!

GMG-CC
24.07.2012, 20:53
Hallo ,

das sollte in etwa so gehen:

Sub GMGCC()
Dim strUserName As String
Dim strEMail As String
Dim strAtPart As String
Dim strUserMail As String

strAtPart = "@unternehmensname.com"
strUserName = Application.UserName
Select Case strUserName
Case "John"
strUserMail = "JohnDoe"
Case "Alex"
strUserMail = "AlexMeier"
'...
End Select
strEMail = strUserName & strAtPart
MsgBox strEMail
End Sub(ungeprüft ...)

walpla
26.07.2012, 17:19
Hallo Günther!

Danke für deine schnelle Antwort! Liege ich damit richtig, dass ich bei deinem Code alle Benutzer,welche dieses Mail senden, eintragen soll?

Ist es nicht möglich den Benutzernamen oder Mailadresse (vom Benutzer, wecher das Mail versendet) von Outlook abzurufen?

Danke für deine Bemühungen!

Lg Walter

GMG-CC
26.07.2012, 20:42
Hallo Walter,

also: Der Benutzer (Anmeldename) wird automatisch ermittelt mit der Zeile strUserName = Application.UserName. Ich wüsste im Moment nicht, wie du das aus Outlook auslesen könntest.

Alternative: Alle User aus OL exportieren und dann in ein Array schreiben. Wäre vielleicht sinnvoller, wenn du sehr viele User hast. Allerdings musst du dann auch für die Verlinkung von Anmeldenamen und Mail-Prefix sorgen.

Falls ich dich falsch verstanden habe, schreib noch mal ...

walpla
28.07.2012, 14:01
Hallo Günther!

Superklasse, Weltspitze und ein großes Danke schön :) !

Nach langem herum versuchen, hab ich in meiner Userform eine Textbox 7
hinzugefügt und bei Userform activate diesen Code eingegeben :

Dim strUserName As String

strUserName = Application.UserName


TextBox7 = strUserName

Ist jetzt unser Login Kürzel, genau das was ich brauche!

Vielen, vielen Dank!

LG aus Wien

Walter

PS: Jetzt muss ich noch ein kleines Problem mit dem Schaltjahr lösen und dann stelle ich die Datei rein!

GMG-CC
28.07.2012, 15:42
PS: Jetzt muss ich noch ein kleines Problem mit dem Schaltjahr lösen und dann stelle ich die Datei rein!

Hallo Walter, danke für die Rückmeldung. Und ansonsten: Einfach fragen, spart meistens so einiges an Arbeit ...:grins:

jeder mann
28.07.2012, 16:39
Hallo, Walter,

Application.Username kann von jedem Benutzer über die Excel-Optionen verändert werden, environ("Username") ist der Name von der Anmeldung am Windowssystem. Schön, wenn bei euch noch die Benutzernamen vom System mit denen in Excel übereinstimmen, aber eine Anwendung darauf aufbauen würde ich nicht.

Hier der Link zu einer Funktion aus dem Forum: http://www.ms-office-forum.net/forum/showthread.php?t=95655

walpla
29.07.2012, 19:26
Hallo Jedermann!

He, he vielen Dank ! Habs getestet,hast Recht! Habe deinen Code impletiert!

Danke schön!

Lg Walter

walpla
29.07.2012, 19:52
Hallo Jedermann!

He, he vielen Dank ! Habs getestet,hast Recht! Habe deinen Code impletiert!

Danke schön!

Danke auch für deinen Link, nur weiß ich nicht wie ich den verwenden soll!

Mein Problem:

Ich lese Daten aus einer Userform und speichere Sie so in eine Tabelle :

Private Sub CommandButton1_Click() ' Eintragen
Sheets("feuerwehrdienst").Activate
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell = TextBox1
ActiveCell.Offset(0, 1) = ComboBox11
ActiveCell.Offset(0, 3) = ComboBox2
ActiveCell.Offset(0, 4) = ComboBox3
ActiveCell.Offset(0, 5) = ComboBox4
ActiveCell.Offset(0, 6) = ComboBox5
ActiveCell.Offset(0, 7) = ComboBox6
ActiveCell.Offset(0, 2) = ComboBox12
TextBox1 = ""
ComboBox11 = ""
ComboBox2 = ""
ComboBox3 = ""
ComboBox4 = ""
ComboBox5 = ""
ComboBox6 = ""
ComboBox12 = ""



Unload Me
End Sub

In den Tabellen Jän bis Dez suche ich Namen mit dieser Formel :
=ZÄHLENWENN(Feuerwehrdienst!$D$366:$H$428;$C67)... für Juli
=ZÄHLENWENN(Feuerwehrdienst!$D$429:$H$490;$C67)...für Aug
=ZÄHLENWENN(Feuerwehrdienst!$D$491:$H$550;$C67)......für Sept

usw

Jetzt hab ich das Problem, dass es nächstes Jahr keinen 29.Feb. gibt und mir die Matrix nicht mehr passt, außer ich ändere immer alle Formeln!

Gibt es eine Möglichkeit nach dem 28.2 (wenn es kein Schaltjahr ist) zwei Zeilen mit einem X einzufügen, damit der Rest wieder passt?

Vielen Dank für Eure Unterstützung!

Lg Walter

walpla
29.07.2012, 21:17
Hallo Günther, hallo Jedermann!

Durch euer Forum habe ich wieder einmal einen Schubser bekommen :-) !

Ich werde meine Formel in:
=WENN(AG5>AF5;ZÄHLENWENN(Feuerwehrdienst!$D$64:$H$121;$C11);ZÄHLENWENN(Feuerwehrdienst!$D$ 64:$H$119;$C11))

abändern und dann stimmts wieder mit der Matrix!

Ob Schaltjahr oder nicht!

Vielen Dank Euch beiden!

Lg Walter

jeder mann
30.07.2012, 05:00
Hallo, Walter,

schön, dass Du Dein Problem mit den Formeln selbst hast lösen können.

Steuerelemente mit den durch VBA vergebenen Namen beim Anlegen zu verwenden ist ein Zeichen dafür, dass Du in einigen Monaten die gleichen Probleme haben wirst wie ich jetzt beim Lesen des Codes für die Schaltfläche: Du wirst auch nachsehen müssen, wofür ComboBox12 steht, woher die Werte kommen, wo sie eingetragen werden sollen. Keine Bange, Erfahrung kommt beim Arbeiten mit VBA, und die Umbenennung vorm Befüllen mit VBA-Code macht die Angelegenheit zumindest für mich einfacher. Ein Kombinationsfeld mit dem Namen cmbNachname "spricht" zu mir, ein Name ComboBox1 sagt mir nur, dass es sich um ein Kombinationsfeld handelt.

Da ich nicht weiß, ob sich noch weitere Steuerelemente auf der UserForm befinden, habe ich Deinen Code ein wenig umgeschrieben und auf eine Schleife verzichtet, da das Versetzen des Zellzeigers in einer Tabelle nicht notwendig ist, um die Werte aus der UserForm in die Tabelle zu bekommen.

Bitte zuerst Deinen Code auskommentieren und diesen an einer Kopie prüfen.

Private Sub CommandButton1_Click() ' Eintragen

Dim lngLR As Long

With Sheets("feuerwehrdienst")
lngLR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(lngLR, "A").Value = TextBox1.Text
.Cells(lngLR, "B").Value = ComboBox11.Text
.Cells(lngLR, "D").Value = ComboBox2.Text
.Cells(lngLR, "E").Value = ComboBox3.Text
.Cells(lngLR, "F").Value = ComboBox4.Text
.Cells(lngLR, "G").Value = ComboBox5.Text
.Cells(lngLR, "H").Value = ComboBox6.Text
.Cells(lngLR, "C").Value = ComboBox12.Text
TextBox1.Text = ""
ComboBox11.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
ComboBox4.Text = ""
ComboBox5.Text = ""
ComboBox6.Text = ""
ComboBox12.Text = ""
End With

Unload Me

End Sub

walpla
31.07.2012, 12:01
Hallo jeder Mann!

Danke für deine Antwort! Ich weiß was du meinst, habe aber Probleme bei der Umsetzung! ich wollt die Comboboxen umbenennen und die Code's anpassen, jedoch kommt bei der Zeile "With Me.Controls("combobox" & cbZaehler)"eine Fehlermeldung wo ich nicht weiter weiß, weil ich diesen Code aus dem Forum habe und für mich angepasst habe! Zur Zeit läuft aber alles gut! Warum genau sollte ich in ein paar Monaten Schwierigkeiten bekommen? Ich trage Daten aus der userform in die Tabelle "Feuerwehrdienst" und hole mittels Formel, Daten aus dieser tabelle retour in die einzelnen Tabellenblättern! Die Formel habe ich umgestellt und verschiebe jetzt die Matrix in den Tabellenblättern, wenn es keinen 29.2 gibt? Oder meinst du weil ich combo1,combo2 etc verwendet habe? ich weiß, dass es mit einer Datei leichter wäre, aber ich würde Sie gerne erst rein stellen, wenn alles läuft, damit User, welche gerade beginnen,daraus lernen können!

Hier mal der komplette Code meiner Userform :

Option Explicit


Private Sub cmVerlassen_Click()
Unload Me
End Sub

Private Sub OK_Click()
Unload Me
End Sub

Private Sub ComboBox1_Change() 'FWK befüllen in Abhängigkeit der Schichtfarbe

Dim I As Long
Dim c As Range
Dim cbZaehler As Integer
Dim FirstAddress As String

Me.ComboBox2.Clear


'Füllen der Comboboxen
Set c = Sheets("FW").Range("A:A").Find(Me.ComboBox1.Value, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
For cbZaehler = 1 To 3
With Me.Controls("combobox" & cbZaehler)
.AddItem Sheets("FW").Range("A:A").Cells(c.Row, cbZaehler)
For I = 0 To .ListCount - 2
If .List(I) = .List(.ListCount - 1) And .ListCount <> 1 Then 'Vergleich, ob schon vorhanden in der Liste
.RemoveItem (.ListCount - 1)
Exit For
End If
Next I 'Liste der Combobox
End With
Next cbZaehler 'Combobox
Set c = Sheets("FW").Range("A:A").FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
Set c = Nothing

End Sub

Private Sub ComboBox12_Change() 'TD oder ND auswählen

Me.ComboBox12.RowSource = "G2:G" & Range("G1").End(xlDown).Row

End Sub

Private Sub ComboBox7_Change() ' FW befüllen in Abhängigkeit der Schichtfarbe

Dim I As Long
Dim c As Range
Dim cbZaehler As Integer
Dim FirstAddress As String

Me.ComboBox3.Clear



'Füllen der Comboboxen
Set c = Sheets("FW").Range("A:A").Find(Me.ComboBox7.Value, LookIn:=xlValues, MatchCase:=False)

If Not c Is Nothing Then
FirstAddress = c.Address
Do
For cbZaehler = 1 To 3
With Me.Controls("combobox" & cbZaehler)
.AddItem Sheets("FW").Range("A:A").Cells(c.Row, cbZaehler)
For I = 0 To .ListCount - 2
If .List(I) = .List(.ListCount - 1) And .ListCount <> 1 Then 'Vergleich, ob schon vorhanden in der Liste
.RemoveItem (.ListCount - 1)
Exit For
End If
Next I 'Liste der Combobox
End With
Next cbZaehler 'Combobox
Set c = Sheets("FW").Range("A:A").FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
Set c = Nothing
End Sub

Private Sub ComboBox8_Change() ' FW befüllen in Abhängigkeit der Schichtfarbe

Dim I As Long
Dim c As Range
Dim cbZaehler As Integer
Dim FirstAddress As String

Me.ComboBox4.Clear


'Füllen der Comboboxen
Set c = Sheets("FW").Range("A:A").Find(Me.ComboBox8.Value, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
For cbZaehler = 1 To 4
With Me.Controls("combobox" & cbZaehler)
.AddItem Sheets("FW").Range("A:A").Cells(c.Row, cbZaehler)
For I = 0 To .ListCount - 2
If .List(I) = .List(.ListCount - 1) And .ListCount <> 1 Then 'Vergleich, ob schon vorhanden in der Liste
.RemoveItem (.ListCount - 1)
Exit For
End If
Next I 'Liste der Combobox
End With
Next cbZaehler 'Combobox
Set c = Sheets("FW").Range("A:A").FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
Set c = Nothing
End Sub
Private Sub ComboBox9_Change() ' FW befüllen in Abhängigkeit der Schichtfarbe

Dim I As Long
Dim c As Range
Dim cbZaehler As Integer
Dim FirstAddress As String

Me.ComboBox5.Clear


'Füllen der Comboboxen
Set c = Sheets("FW").Range("A:A").Find(Me.ComboBox9.Value, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
For cbZaehler = 1 To 5
With Me.Controls("combobox" & cbZaehler)
.AddItem Sheets("FW").Range("A:A").Cells(c.Row, cbZaehler)
For I = 0 To .ListCount - 2
If .List(I) = .List(.ListCount - 1) And .ListCount <> 1 Then 'Vergleich, ob schon vorhanden in der Liste
.RemoveItem (.ListCount - 1)
Exit For
End If
Next I 'Liste der Combobox
End With
Next cbZaehler 'Combobox
Set c = Sheets("FW").Range("A:A").FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
Set c = Nothing
End Sub
Private Sub ComboBox10_Change() ' FW befüllen in Abhängigkeit der Schichtfarbe

Dim I As Long
Dim c As Range
Dim cbZaehler As Integer
Dim FirstAddress As String

Me.ComboBox6.Clear


'Füllen der Comboboxen
Set c = Sheets("FW").Range("A:A").Find(Me.ComboBox10.Value, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
For cbZaehler = 1 To 6
With Me.Controls("combobox" & cbZaehler)
.AddItem Sheets("FW").Range("A:A").Cells(c.Row, cbZaehler)
For I = 0 To .ListCount - 2
If .List(I) = .List(.ListCount - 1) And .ListCount <> 1 Then 'Vergleich, ob schon vorhanden in der Liste
.RemoveItem (.ListCount - 1)
Exit For
End If
Next I 'Liste der Combobox
End With
Next cbZaehler 'Combobox
Set c = Sheets("FW").Range("A:A").FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
Set c = Nothing
End Sub


Private Sub CommandButton1_Click() ' Eintragen in Tab Fuerwehrdienst

Dim lngLR As Long

With Sheets("feuerwehrdienst")
lngLR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(lngLR, "A").Value = TextBox1.Text 'Datum
.Cells(lngLR, "B").Value = ComboBox11.Text ' Schicht im Dienst
.Cells(lngLR, "D").Value = ComboBox2.Text ' Feuerwehrkommandant
.Cells(lngLR, "E").Value = ComboBox3.Text ' Atemschutzträger 1
.Cells(lngLR, "F").Value = ComboBox4.Text ' Atemschutzträger 2
.Cells(lngLR, "G").Value = ComboBox5.Text ' Atemschutzträger 3
.Cells(lngLR, "H").Value = ComboBox6.Text ' Lotse
.Cells(lngLR, "C").Value = ComboBox12.Text ' Schichtdienst
TextBox1.Text = ""
ComboBox11.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
ComboBox4.Text = ""
ComboBox5.Text = ""
ComboBox6.Text = ""
ComboBox12.Text = ""
End With

Unload Me

End Sub





Sub UserForm_Activate()

Worksheets("FW").Activate

Me.ComboBox1.Clear
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ComboBox4.Clear
Me.ComboBox5.Clear
Me.ComboBox6.Clear
Me.ComboBox7.Clear
Me.ComboBox8.Clear
Me.ComboBox9.Clear
Me.ComboBox10.Clear
Me.ComboBox11.Clear
Me.ComboBox12.Clear

'1. Spalte
Dim StListe() As String
Dim Loletzte As Long
Dim LoI As Long

Loletzte = 65536
If Range("A65536") = "" Then Loletzte = Range("A65536").End(xlUp).Row
'Array Dimensionieren
ReDim Preserve StListe(1 To Loletzte)
For LoI = 2 To Loletzte
StListe(LoI - 1) = Cells(LoI, 1)
Next LoI

' Liste in Listbox übertragen ohne Doppelte
ComboBox1.AddItem StListe(1)
ComboBox7.AddItem StListe(1)
ComboBox8.AddItem StListe(1)
ComboBox9.AddItem StListe(1)
ComboBox10.AddItem StListe(1)
ComboBox11.AddItem StListe(1)




For LoI = 2 To Loletzte

If StListe(LoI) <> StListe(LoI - 1) And StListe(LoI) <> "Schicht" Then ComboBox1.AddItem StListe(LoI)
If StListe(LoI) <> StListe(LoI - 1) And StListe(LoI) <> "Schicht" Then ComboBox7.AddItem StListe(LoI)
If StListe(LoI) <> StListe(LoI - 1) And StListe(LoI) <> "Schicht" Then ComboBox8.AddItem StListe(LoI)
If StListe(LoI) <> StListe(LoI - 1) And StListe(LoI) <> "Schicht" Then ComboBox9.AddItem StListe(LoI)
If StListe(LoI) <> StListe(LoI - 1) And StListe(LoI) <> "Schicht" Then ComboBox10.AddItem StListe(LoI)
If StListe(LoI) <> StListe(LoI - 1) And StListe(LoI) <> "Schicht" Then ComboBox11.AddItem StListe(LoI)





Next LoI



TextBox1 = Date

Me.ComboBox12.RowSource = "G3:G" & Range("G1").End(xlDown).Row

End Sub