Code: Select all
*********************************************
* CONEXION DE DSGCD 2004 CON OUTLOOK 2000 * EN PREPARACION
* *
* EXPORTA / IMPORTA DATOS Y SINCRONIZA * OUTLOOK.PRG
*********************************************
#include "FIVEWIN.CH"
//--------------------------------------------------------------------
// PASA TODAS LAS DIRECCIONES DE OUTLOOK A DSGCD COMPARANDO PRIMERO SI
// EXISTEN POR SU EMAIL O SI NO LO TIENE POR NOMBRE+APELLIDOS+EMPRESA
//--------------------------------------------------------------------
FUNCTION OUTLK2DIRTEL()
LOCAL oOL, oLista, oMail, i, oNameSpace, lcMessage, oContact, oNewContact
LOCAL oDirtel,oTipodirt,nCodigo:=0,lCategoria:=.F.,nCategoria:=0,nCatoutlook:=0
LOCAL nNuevos:=0
//Abrir conexión OLE
oOL := TOleAuto():New( "Outlook.Application.9" )
IF Ole2TxtError() != "S_OK"
MsgAlert("Outlook 2000 no está disponible.", "Error")
Return .F.
Endif
//Abrir archivos
IF !NETUSE(IF(nIDIOMA=5,"TIPODIPG","TIPODIES"))
Return .F.
Endif
DATABASE oTipodirt
oTipodirt:bEOF:={|| NIL}
Do While !oTipodirt:Eof()
If ALLTRIM(oTipodirt:Tipodirt)=="OUTLOOK"
lCategoria:=.T.
nCatoutlook:=oTipodirt:Codigo
Endif
nCategoria:=If(oTipodirt:Codigo>nCategoria,oTipodirt:Codigo,nCategoria)
oTipodirt:Skip()
Enddo
If !lCategoria
nCatoutlook:=++nCategoria
oTipodirt:Append()
oTipodirt:Codigo :=nCatoutlook
oTipodirt:Tipodirt:="OUTLOOK"
oTipodirt:Save()
Endif
IF !NETUSE("DIRTEL")
oTipodirt:Close()
Return .F.
ENDIF
DATABASE oDirtel
oDirtel:bEOF:={|| NIL}
oDirtel:Gobottom()
nCodigo:=Val(oDirtel:Codigo)
oDirtel:Setorder("EMAIL")
//Recorre la lista de contactos
WAITON("Cargando lista de contactos OUTLOOK")
oNameSpace = oOL:Get("GetNameSpace","MAPI")
oContacts = oNameSpace:Get("GetDefaultFolder","10")
ShowOleErrors( .F. )
FOR nContador = 1 TO oContacts:Items:Count()
oContact = oContacts:Items(nContador)
lNombre:=oContact:get("FirstName")
If ValType(lNombre)="C" //Para descartar que no sea un grupo de contactos
lNuevo:=.F.
If !oDirtel:Seek(IF(Len(Alltrim(oContact:get("Email1Address")))>0,;
Alltrim(oContact:get("Email1Address")),;
Alltrim(PADR(oContact:get("LastName"),40)+;
PADR(oContact:get("FirstName"),25)+;
PADR(oContact:get("CompanyName"),50) ) ) )
oDirtel:Append()
oDirtel:CODIGO :=Strzero(++nCodigo,8)
oDirtel:APELLIDOS :=oContact:get("LastName")
oDirtel:NOMBRE :=oContact:get("FirstName")
oDirtel:EMPRESA :=oContact:get("CompanyName")
oDirtel:TLF1 :=oContact:get("BusinessTelephoneNumber")
oDirtel:TLF2 :=oContact:get("Business2TelephoneNumber")
oDirtel:TLF3 :=oContact:get("HomeTelephoneNumber")
oDirtel:FAX :=oContact:get("BusinessFaxNumber")
oDirtel:MOVIL :=oContact:get("MobileTelephoneNumber")
oDirtel:DIRECCION :=oContact:get("BusinessAddress")
If Empty(oDirtel:DIRECCION)
oDirtel:DIRECCION :=oContact:get("HomeAddressStreet")
Endif
oDirtel:POBLACION :=oContact:get("BusinessAddressCity")
If Empty(oDirtel:POBLACION)
oDirtel:POBLACION :=oContact:get("HomeAddressCity")
Endif
oDirtel:CP :=oContact:get("BusinessAddressPostalCode")
If Empty(oDirtel:CP)
oDirtel:CP :=oContact:get("HomeAddressPostalCode")
Endif
oDirtel:DNINIF :=""
oDirtel:CUMPLE :=""
oDirtel:RECORDAR :=.F.
oDirtel:TRANSFER :=.F.
oDirtel:AVISADO :=Ctod(" - - ")
oDirtel:EMAIL :=oContact:get("Email1Address")
oDirtel:WWW :=oContact:get("WebPage")
oDirtel:CATEGORIA :=nCategoria
oDirtel:OBSERVA :=""
oDirtel:LOUTLOOK :=.T.
oDirtel:Modificado:=Dtos(Date())+Time()
oDirtel:Save()
nNuevos++
Endif
Endif
Next
ShowOleErrors( .T. )
WAITOFF()
//Cerrar conexión OLE y Archivos
oOL:End()
oDirtel:Close()
oTipodirt:Close()
If nNuevos>0
Msginfo(IF(!lCategoria,"Añadida la categoría de contactos OUTLOOK"+CRLF+CRLF,"")+;
"Se han añadido "+ALLTRIM(STR(nNuevos))+" registros de OutLook","Finalizado")
Else
Msginfo("No se han añadido contactos nuevos de Outlook","Finalizado")
Endif
RETURN .T.
//--------------------------------------------------------------------
// PASA TODAS LAS DIRECCIONES DE DSGCD A OUTLOOK COMPARANDO PRIMERO SI
// EXISTEN POR SU EMAIL O SI NO LO TIENE POR NOMBRE+APELLIDOS+EMPRESA
//--------------------------------------------------------------------
FUNCTION DIRTEL2OUTLK()
LOCAL oOL, oLista, oMail, i, oNameSpace, lcMessage, oContact, oNewContact
LOCAL oDirtel,oTipodirt,nCodigo:=0,lCategoria:=.F.,nCategoria:=0,nCatoutlook:=0
LOCAL nNuevos:=0, aTablaOutlk:=Array(0)
//Abrir conexión OLE
oOL := TOleAuto():New( "Outlook.Application.9" )
IF Ole2TxtError() != "S_OK"
MsgAlert("Outlook 2000 no está disponible.", "Error")
Return .F.
Endif
//Abrir archivos
IF !NETUSE(IF(nIDIOMA=5,"TIPODIPG","TIPODIES"))
Return .F.
Endif
DATABASE oTipodirt
oTipodirt:bEOF:={|| NIL}
IF !NETUSE("DIRTEL")
oTipodirt:Close()
Return .F.
ENDIF
DATABASE oDirtel
oDirtel:bEOF:={|| NIL}
//Recorre la lista de contactos
WAITON("Exportando lista de contactos a OUTLOOK")
oNameSpace = oOL:Get("GetNameSpace","MAPI")
oContacts = oNameSpace:Get("GetDefaultFolder","10")
FOR nContador = 1 TO oContacts:Items:Count()
oContact = oContacts:Items(nContador)
Do While !oDirtel:Eof()
oDirtel:Modificado:=Dtos(Date())+Time()
oNewContact = oContacts:Items:Add()
oNewContact:Set("LastName",oDirtel:APELLIDOS)
oNewContact:Set("FirstName",oDirtel:NOMBRE)
oNewContact:Set("CompanyName",oDirtel:EMPRESA)
oNewContact:Set("BusinessTelephoneNumber",oDirtel:TLF1)
oNewContact:Set("Business2TelephoneNumber",oDirtel:TLF2)
oNewContact:Set("HomeTelephoneNumber",oDirtel:TLF3)
oNewContact:Set("BusinessFaxNumber",oDirtel:FAX)
oNewContact:Set("MobileTelephoneNumber",oDirtel:MOVIL)
oNewContact:Set("BusinessAddress",oDirtel:DIRECCION)
oNewContact:Set("BusinessAddressCity",oDirtel:POBLACION)
oNewContact:Set("BusinessAddressPostalCode",oDirtel:CP)
oNewContact:Set("Email1Address",oDirtel:EMAIL)
oNewContact:Set("WebPage",oDirtel:WWW)
oNewContact:Save()
nNuevos++
oDirtel:Save()
oDirtel:Skip()
Enddo
Next
ShowOleErrors( .T. )
WAITOFF()
//Cerrar conexión OLE y Archivos
oOL:End()
oDirtel:Close()
oTipodirt:Close()
If nNuevos>0
Msginfo("Se han añadido "+ALLTRIM(STR(nNuevos))+" registros de DSGCD a OutLook","Finalizado")
Else
Msginfo("No se han añadido contactos nuevos de DSGCD a Outlook","Finalizado")
Endif
RETURN .T.
//--------------------------------------------------------------------
STATIC PROCEDURE OUTLOOK()
LOCAL oOL, oLista, oMail, i, oNameSpace, lcMessage, oContact, oNewContact
oOL := TOleAuto():New( "Outlook.Application.9" )
IF Ole2TxtError() != "S_OK"
MsgAlert("Outlook 2000 no está disponible.", "Error")
ELSE
oNameSpace = oOL:Get("GetNameSpace","MAPI")
oContacts = oNameSpace:Get("GetDefaultFolder","10")
//Recorre la lista de contactos y los muestra
FOR lnContador = oContacts:Items:Count() to 1 step -1
oContact = oContacts:Items(lnContador)
lNombre:=oContact:get("FirstName")
If ValType(lNombre)="C"
lcMessage= "Contacto: " + CHR(9) + STR(lnContador) + CHR(13) + CHR(10) +;
"Nombre: " + CHR(9) + oContact:get("FirstName") + CHR(13) + CHR(10) +;
"Apellido: " + CHR(9) + oContact:get("LastName") + CHR(13) + CHR(10) +;
"Empresa: " + CHR(9) + oContact:get("CompanyName")+ CHR(13) + CHR(10) +;
"movil: " + CHR(9) + oContact:get("MobileTelephoneNumber")+ CHR(13) + CHR(10) +;
"email: " + CHR(9) + oContact:get("Email1Address")
? lcmessage
Endif
Next
/*
//Añadir un contacto
oNewContact = oContacts:Items:Add()
oNewContact:Set("FirstName", "Filippo")
oNewContact:Set("LastName", "Cavalcanti")
oNewContact:Set("FullName", "Filippo Cavalcanti")
oNewContact:Set("CompanyName","Global Connection")
oNewContact:Save()
*/
/*
//Añadir grupo de contactos
oMail := oOL:CreateItem( 0 ) // olMailItem
FOR i := 1 TO 10
oMail:Recipients:Add( "Contacto" + LTRIM( STR( i, 2 ) ) + ;
"<contacto" + LTRIM( STR( i, 2 ) ) + "@servidor.com>" )
NEXT
oLista := oOL:CreateItem( 7 ) // olDistributionListItem
oLista:DLName := "Prueba de lista de distribución"
oLista:Display( .F. )
oLista:AddMembers( oMail:Recipients )
oLista:Save()
oLista:Close( 0 )
oMail:End()
oLista:End()
*/
oOL:End()
ENDIF
RETURN