| 
                              
                                  Thema
                              
                           | 
                          
                              
                                  Datum 
                           | 
                          
                              
                                  Von Nutzer
                           | 
                          
                              
                                  Rating
                           | 
                          
                               
                                  Antwort 
                           | 
                      
                      
 | 
24.02.2017 10:56:08 | 
Martin | 
 | 
 | 
 | 
24.02.2017 22:02:02 | 
BigBen | 
 | 
 | 
  Outlook empfangene Mail Feld aus Kontakte auslesen  | 
25.02.2017 10:58:34 | 
Martin | 
 | 
 | 
 | 
25.02.2017 14:21:06 | 
BigBen | 
 | 
 | 
 | 
25.02.2017 14:51:32 | 
BigBen | 
 | 
 | 
 | 
25.02.2017 14:59:44 | 
BigBen | 
 | 
 | 
 | 
25.02.2017 11:01:32 | 
Martin | 
 | 
 | 
 | 
25.02.2017 15:33:52 | 
BigBen | 
 | 
 | 
 | 
25.02.2017 15:36:39 | 
BigBen | 
 | 
 | 
                  
    
                    
             
								 
									
										Von: 
                                            Martin | 
										Datum: 
                                            25.02.2017 10:58:34 | 
										Views:
                                             
                                            993 | 
										Rating:
                                                                          | 
										Antwort: 
                                             
                                             
                                             | 
									
									
										Thema:
                                             
                                            Outlook empfangene Mail Feld aus Kontakte auslesen | 
									
									
										|  
                                            Super, danke - leider passiert bei beim Eingang von einer Mail .... gar nichts - der Code ist bei ThisOutlookSession eingefügt - außerdem soll das Kopieren der Abteilung nicht bei Eingang der Mail sondern bei Öffnen der Mail per Doppelklick ausgeführt werden - wie muss hier der Code angepasst werden - danke!
Martin
Private WithEvents m_Inbox As Outlook.Items
Private m_Contacts As Outlook.Items
Friend Sub Application_Startup()
  Set m_Inbox = Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub m_Inbox_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
    Set m_Contacts = Application.Session.GetDefaultFolder(olFolderContacts).Items
    UpdateEmail Item
  End If
End Sub
Private Sub UpdateEmail(Mail As Outlook.MailItem)
  Dim Contact As Outlook.ContactItem
  Dim Props As Outlook.UserProperties
  Dim Prop As Outlook.UserProperty
  Dim Name As String
  MsgBox "Test"
  Set Contact = GetContact(Mail.SenderEmailAddress)
  If Not Contact Is Nothing Then
    Set Props = Mail.UserProperties
    
    Set Prop = GetUserProperty(Props, "AbsenderName")
    Prop.Value = Contact.FullName
    
    Set Prop = GetUserProperty(Props, "AbsenderFirma")
    Prop.Value = Contact.CompanyName
    
    CopyTextInClipart Contact.Department
    
    Mail.Save
  End If
End Sub
Private Function GetUserProperty(Props As Outlook.UserProperties, Name As String) As Outlook.UserProperty
  Dim Prop As Outlook.UserProperty
  Set Prop = Props.Find(Name)
  If Prop Is Nothing Then
    Set Prop = Props.Add(Name, olText, True)
  End If
  Set GetUserProperty = Prop
End Function
Private Function GetContact(Adr As String) As Outlook.ContactItem
  Dim Contact As Outlook.ContactItem
  Set Contact = m_Contacts.Find("[Email1Address]='" & Adr & "'")
  If Contact Is Nothing Then
    Set Contact = m_Contacts.Find("[Email2Address]='" & Adr & "'")
  End If
  If Contact Is Nothing Then
    Set Contact = m_Contacts.Find("[Email3Address]='" & Adr & "'")
  End If
  Set GetContact = Contact
End Function
Sub CopyTextInClipart(strTMP As String)
    Dim objClip As Object
    Set objClip = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    'Dim objClip As dataobject
    'Set objClip = New dataobject
    objClip.SetText strTMP
    objClip.PutInClipboard
End Sub     | 
									
								
							
 					
		   
 
                          
                        
                                
                    - Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
 
                                        - Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
 
                        - Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
 
                        - Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
 
                        - Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei 
    Antworten auf Ihren Beitrag zu benachrichtigen
 
                                    
                            
                             
                          
	
                         
                                  
                             
                             Bitte geben Sie ein aussagekräftiges Thema an. 
                            
                            Bitte geben Sie eine gültige Email Adresse ein!
                            
                            
                       
                                - Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
 
                                        - Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
 
                        - Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
 
                        - Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
 
                        - Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei 
    Antworten auf Ihren Beitrag zu benachrichtigen
 
                                    
                        
                            
                        
                         
                                                  
 
                                       
                            
                      
                          | 
                              
                                  Thema                               
                           | 
                          
                              
                                  Datum 
                           | 
                          
                              
                                  Von Nutzer
                           | 
                          
                              
                                  Rating
                           | 
                          
                               
                                  Antwort 
                           | 
                      
                      
 | 
24.02.2017 10:56:08 | 
Martin | 
 | 
 | 
 | 
24.02.2017 22:02:02 | 
BigBen | 
 | 
 | 
  Outlook empfangene Mail Feld aus Kontakte auslesen  | 
25.02.2017 10:58:34 | 
Martin | 
 | 
 | 
 | 
25.02.2017 14:21:06 | 
BigBen | 
 | 
 | 
 | 
25.02.2017 14:51:32 | 
BigBen | 
 | 
 | 
 | 
25.02.2017 14:59:44 | 
BigBen | 
 | 
 | 
 | 
25.02.2017 11:01:32 | 
Martin | 
 | 
 | 
 | 
25.02.2017 15:33:52 | 
BigBen | 
 | 
 | 
 | 
25.02.2017 15:36:39 | 
BigBen | 
 | 
 |