VBA_prozedur
axiser
ich habe vor einigen tagen folgende vba-prozedur in dieser newsgroup
erhalten:
mein problem war, um es "nochmal" zu erwähnen, wie ich daten aus einer
excel tabelle (kontakt, anschrift, tel., ort, .....) in outlook importieren
kann. das
grosse problem liegt aber dabei, dass ich in dem neuen OL98 formular neue
felder hinzugefügt habe, die halt auch schon in excel tabelle existieren.
diese
sollen halt auch mit rein.
wer hat ideen??
----------------------------------------------------------------------------
Sub AdressenAnOutlook()
Dim xls As Worksheet
Dim ola As Outlook.Application
Dim olc As Outlook.ContactItem
Dim r As Integer
' Zugriff auf die aktuelle Tabelle herstellen
Set xls = ActiveWorkbook.ActiveSheet
' Zugriff auf Outlook herstellen
Set ola = CreateObject("Outlook.Application")
' Alle Adressen in der Tabelle der Reihe nach abarbeiten
For r = 5 To 47 ' Die Adressen stehen in den Zeilen 5 bis 47
' Neuen Outlook-Kontakt erstellen
Set olc = ola.CreateItem(olContactItem)
olc.FirstName = xls.Cells(r, 1) ' Vorname in Spalte 1 (A)
olc.LastName = xls.Cells(r, 2) ' Nachname steht in Spalte 2
(C)
olc.Department = xls.Cells(r, 3) ' Abteilung steht in Spalte 3
(C)
olc.JobTitle = xls.Cells(r, 4) ' Position steht in Spalte 4
(D)
olc.Email1Address = xls.Cells(r, 5) ' Email-Adresse steht in Spalte
5 (E)
' Alle Adressen in der Tabelle gehören zu selben Firma (sind
konstant)
olc.CompanyName = "XYZ GmbH"
olc.MailingAddressStreet = "Sackgasse 5"
olc.MailingAddressPostalCode = "12345"
olc.MailingAddressCity = "Berlin"
olc.MailingAddressCountry = "Deutschland"
olc.BusinessTelephoneNumber = "+49 (30) 123 456 789"
olc.BusinessFaxNumber = "+49 (30) 987 654 321"
' Speichern unter "Firma (Nachname, Vorname)"
olc.FileAs = olc.CompanyName & " (" & olc.LastName & ", " &
olc.FirstName & ")"
' Neuen Kontakt speichern und Fenster schliessen
' (Es ging wahrscheinlich so schnell, dass das Fenster gar nicht
erst
' angezeigt wurde.)
olc.Close olSave
Next r
end sub
Hans-Juergen Neschtschenko
a) Referenz auf den Kontakteordner setzen.
b) Anstelle von createitem verwendest du
set myitem=meinfolder.items.add("MeinFormular")
c) Über die userproperties von myitem hast du dann Zugriff auf die
selbstdefinierten Felder.
Dein olc wird übrigens deswegen nicht angezeigt, weil nirgendwo im code ein
olc.display steht. Das macht nix. Aber man muss sich klar darüber sein, dass
damit auch der ietm_open-event nicht angestoßen wird und evtl dort
untergebrachte code nicht läuft.
--
MfG Hans-Jürgen
--------
Was du schon immer wissen wolltest:
http://www.pc-faq.de/outlook
axiser schrieb in Nachricht <61ph3.110$Mu.2...@news.tli.de>...
W.Flamme
daten aus einer
>excel tabelle (kontakt, anschrift, tel., ort, .....) in
outlook importieren
>kann. das
>grosse problem liegt aber dabei, dass ich in dem neuen OL98
formular neue
>felder hinzugefügt habe, die halt auch schon in excel
tabelle existieren.
Hi,
Ich glaube, die CreateItem-Methode geht nur bei
Standardformularen. Verwende lieber die Item.Add-Methode.
An die benutzerdef. OL Felder kommst Du so ran:
Item.UserProperties.Find("Feldname").Value=....
Hier ein Bsp wie's unter Access funktioniert. Hintergrund:
In einem PST-Ordner namens 'Entwurf' exustiert ein
Subfolder namens 'WWW-Links'. Diesem ist ein
benutzerdefiniertes Formular (abgeaendertes Kontaktformular)
'IPM.Contact.WWW-Links' zugeordnet.
Der Inhalt einer Access-Tabelle 'Bookmarks' , die
gesammelte Links enthaelt, soll nun unter Verwendung dieses
OL-Formulars nach OL geschoben werden. Dazu muss natuerlich
in den Acc-Verweisen das OL-Objektmodell aktiviert sein.
Sub CreateBookmarks()
Dim db As Database
Dim rs As Recordset
Dim ol As New Outlook.Application
Dim ns As Outlook.NameSpace
Dim fds As Outlook.Folders
Dim fd As Outlook.mapiFolder
Dim obcont As Outlook.ContactItem
Set db = CurrentDb
Set rs = db.OpenRecordset("Bookmarks", dbOpenTable)
Set ns = ol.GetNamespace("MAPI")
Set fds = ns.Folders("Entwurf").Folders
For Each fd In fds
'man kann natuerlich auch direkt auf
'den Subfolder verweisen, aber
'ich wollte mal ein Durchlaufen
'der Folders-Collection demonstrieren
If fd.Name = "WWW-Links" Then
rs.MoveFirst
Do Until rs.EOF
Set obcont =
fd.Items.Add("IPM.Contact.WWW-Links")
With obcont
.Subject = IIf(IsNull(rs!Inhalt), "",
rs!Inhalt)
.FileAs = IIf(IsNull(rs!Inhalt), "",
rs!Inhalt)
.WebPage = IIf(IsNull(rs!Link), "", rs!Link)
.Language = IIf(IsNull(rs!Sprache), "",
rs!Sprache)
.Body = IIf(IsNull(rs!Beschreibung), "",
rs!Beschreibung)
'.UserProperties.Find("BenutzerdefiniertesFormFeld").Value =
rs!irgendwas
.Save
End With
rs.MoveNext
Loop
End If
Next
rs.Close
Set ol = Nothing
Set db = Nothing
End Sub