Resumen Sincronizar contactos Outlook con mdb

Mensaje enviado por José Braulio Moreno Suárez <jbmoreno@supercable.es> el 22/11/2001

Esto marcha, queda más o menos así (crear contactos desde *.mdb)

'* * * * * * * * * * * * * * * * * * * * * * * * * * *
'* Este módulo Crea contactos en Outlook *
'* recorriendo una Base de Datos *.mdb *
'* Debe estar instalada la biblioteca de referencias *
'* Microsoft DAO 3.6 Objetc Library *
'* * * * * * * * * * * * * * * * * * * * * * * * * * *
Sub BuscarContactosDeBaseDeDatos()

    'Establece las variables
    Dim dbsBaseDeDatos As Database
    Dim rstTablaBaseDeDatos As Recordset
    Dim strTablaBaseDeDatos As String
    Dim strCampoNombreCompletoDeTablaBaseDeDatos As String

    Dim strConsultaCampoDeTablaBaseDeDatos As String

    'Establece los valores de las variables
    strTablaBaseDeDatos = "C:\WGOLDEN\DATOS\FART3D.mdb"
    strConsultaCampoDeTablaBaseDeDatos = "SELECT Agentes.Codigo,
Agentes.Nombre, Agentes.Domicilio, Agentes.[C Postal],
Agentes.Poblacion, Agentes.Pais, Agentes.Telefono1, Agentes.Telefono2,
Agentes.Fax, Agentes.EMail, Agentes.[Pagina Web] FROM Agentes ORDER BY
Agentes.Nombre" 'Copia una Sentencia SQL de Access
    Set dbsBaseDeDatos = OpenDatabase(strTablaBaseDeDatos)
    Set rstTablaBaseDeDatos =
dbsBaseDeDatos.OpenRecordset(strConsultaCampoDeTablaBaseDeDatos,
dbOpenSnapshot)

    'Llena el Recordset
    With rstTablaBaseDeDatos
        .MoveLast
        .MoveFirst
            'Recorre todos los Registros y crea el contacto
            For Contacto = 1 To .RecordCount
                strCampoNombreCompletoDeTablaBaseDeDatos = !Nombre
                .MoveNext
                'Llama a la Rutina que crea el Contacto en Outlook
                CrearContactoEnOutlook
(strCampoNombreCompletoDeTablaBaseDeDatos)
            Next Contacto
        .Close
    End With

    'Cierra la base de datos abierta
    dbsBaseDeDatos.Close

End Sub
Sub CrearContactoEnOutlook(strCampoNombreCompletoDeTablaBaseDeDatos As
String)

'Establece los Objetos y carpetas de Outlook donde se van a crear los
contactos
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
Set myItem = myOlApp.CreateItem(olContactItem)

'Establece los valores de los Campos del Formulario Contactos de Outlook
With myItem
    .FullName = strCampoNombreCompletoDeTablaBaseDeDatos 'Nombre
completo
    'Salva los Objetos
    myItem.Save
End With
End Sub



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com