sammy286
02-10-2006, 10:17
Ciao!!! :)
Vorrei chiedere se qualcuno può aiutarmi a far si di creare un programmino che mi permetta di aggiornare una tabella Access con i contatti presenti in Outlook! :cry: :cry: :cry:
Io faccio già qst cosa,ma tramite una macro di Access...vorrei far si di riuscire a farlo tramite Vb script,indipendento dall'apertura di Access!!!
Spero di essermi fatto capire...ecco il codice che uso io:
Sub ImportContactsFromOutlook()
' Set up DAO objects (uses existing "Contatti" table)
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Contatti")
' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.NameSpace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim Prop As Outlook.UserProperty
Set olns = ol.GetNamespace("MAPI")
Set cf = olns.GetDefaultFolder(olFolderContacts)
Set objItems = cf.Items
iNumContacts = objItems.Count
If iNumContacts <> 0 Then
For i = 1 To iNumContacts
If TypeName(objItems(i)) = "ContactItem" Then
Set c = objItems(i)
rst.AddNew
rst!FirstName = c.FirstName
rst!LastName = c.LastName
rst!HomeTelephoneNumber = c.HomeTelephoneNumber
rst.Update
End If
Next i
rst.Close
MsgBox "Finished."
Else
MsgBox "No contacts to export."
End If
End Sub
Grazie dell'attenzione...spero di avere qualche aiuto!!!
Vorrei chiedere se qualcuno può aiutarmi a far si di creare un programmino che mi permetta di aggiornare una tabella Access con i contatti presenti in Outlook! :cry: :cry: :cry:
Io faccio già qst cosa,ma tramite una macro di Access...vorrei far si di riuscire a farlo tramite Vb script,indipendento dall'apertura di Access!!!
Spero di essermi fatto capire...ecco il codice che uso io:
Sub ImportContactsFromOutlook()
' Set up DAO objects (uses existing "Contatti" table)
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Contatti")
' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.NameSpace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim Prop As Outlook.UserProperty
Set olns = ol.GetNamespace("MAPI")
Set cf = olns.GetDefaultFolder(olFolderContacts)
Set objItems = cf.Items
iNumContacts = objItems.Count
If iNumContacts <> 0 Then
For i = 1 To iNumContacts
If TypeName(objItems(i)) = "ContactItem" Then
Set c = objItems(i)
rst.AddNew
rst!FirstName = c.FirstName
rst!LastName = c.LastName
rst!HomeTelephoneNumber = c.HomeTelephoneNumber
rst.Update
End If
Next i
rst.Close
MsgBox "Finished."
Else
MsgBox "No contacts to export."
End If
End Sub
Grazie dell'attenzione...spero di avere qualche aiuto!!!