Visual Basic 6 - Importare in visual basic i contatti della rubrica di office microsoft outlook

Buonasera, vorrei sapere se è possibile importare in vb tutti i contatti che ho sulla rubrica di outlook.

Ho visto che il riferimento a micrisift outlook esiste è l' ho già aggiunto, ma non saprei da dove partire.

Qualcuno sa un modo ?

Occorre usare l'automazione.
Puoi iniziare da qui:

Early-Late Binding in VB6 con Excel & Outlook
nuke.vbcorner.net/Articoli/VB60/EarlyLateBinding/tabid/107/language/it-IT/…

Poi dovrai studiarti la guida a Visual Basic for Application (VBA) che trovi nell'ambiente di progettazione VBA di Outlook.
Nota che per default la guida a VBA NON viene installata, devi riavvia l'installazione di Office ed installarla (già che ci sei installala anche per Excel, Word, ...

Posto la mia soluzione


Dim strsql As String
Dim olkAddressList As Outlook.AddressEntry

Dim ns As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set ns = GetNamespace("MAPI"
Set objFolder = ns.PickFolder


Dim obj As Outlook.MailItem
Dim olKList As Outlook.AddressList

Dim intCounter As Integer
Set adoConn = CreateObject("ADODB.Connection"
Set adors = CreateObject("ADODB.Recordset"
adoConn.Open "DSN=DatiOutlook;"
Cartella = objFolder
Label1.Caption = "Nome contatto: " & objFolder & " con " & objFolder.Items.Count & " elementi."
adors.Open "SELECT * FROM email", adoConn, adOpenDynamic ', adLockBatchOptimistic

For intCounter = objFolder.Items.Count To 1 Step -1
With objFolder.Items(intCounter) 'Print the

' se ci sono i segni ' allora li devo sostituirecon gli spazi
Nomecont = .FullName: List1.AddItem .FullName
If TestPos <> InStr(1, Nomecont, "'" Then Nomecont = Replace(Nomecont, "'", ""
Emailcont = .Email1Address: List1.AddItem .Email1Address
If TestPos <> InStr(1, Emailcont, "'" Then Emailcontt = Replace(Emailcont, "'", ""
IndirizzoCont = .HomeAddress: List1.AddItem .HomeAddress
If TestPos <> InStr(1, IndirizzoCont, "'" Then IndirizzoCont = Replace(IndirizzoCont, "'", ""
TelefonoCont = .HomeTelephoneNumber: List1.AddItem .HomeTelephoneNumber
If TestPos <> InStr(1, TelefonoCont, "'" Then TelefonoCont = Replace(TelefonoCont, "'", ""
CellulareCont = .MobileTelephoneNumber: List1.AddItem .MobileTelephoneNumber
If TestPos <> InStr(1, CellulareCont, "'" Then CellulareCont = Replace(CellulareCont, "'", ""

End With 'for the Contact with

If Emailcont <> "" Then
' adesso devo scrivere sul DB
strsql = "INSERT INTO email " & _
"(CartellaContatti,Nome,Email,Telefono,Cellulare,Indirizzo)" & _
"VALUES " & _
"('" & Cartella & "','" & Nomecont & "','" & Emailcont & "','" & TelefonoCont & "','" & CellulareCont & "','" & IndirizzoCont & "')"

adoConn.Execute strsql 'scrivo sul file del db
End If

Next
adors.Close
Set adors = Nothing
Set adoConn = Nothing
Set ns = Nothing
Set objFolder = Nothing