Leer mail con adjunto.

[FiveWiDi]

Hola a todos,

¿Alguien tiene una rutina para leer el mail de una cuenta de correo y extraer de él el fichero adjunto que lleva?

Gracias,

[hmpaquito]

Hombre, eso va a depender del cliente de correo que utilizas. Si utilizas Microsoft Outlook eso se puede hacer facilmente. Si utilizas correos Web entonces NPI.

[FiveWiDi]

Hombre, eso va a depender del cliente de correo que utilizas. Si utilizas Microsoft Outlook eso se puede hacer facilmente. Si utilizas correos Web entonces NPI.

La idea era atacar directamente el servidor de correo; pero si se pudira usando Windows Live Mail pues más vale eso que nada.

Gracias.

[karinha]

http://www.fivewin.com.br/Dicas/1063RMail.rar

[FiveWiDi]

Bueno,

He estado mirando los post de este foros y las clases TSmpt, TPop3 y TMail que trae Fivewin, y no acabo de ver como poder leer los ficheros adjuntos de un mail recibido.

¿Nadie ha tenido esta necesidad?

¿Cómo podemos capturar un fichero que hemos recibido en un mail?

Gracias.

[hmpaquito]

FiveWidi,

Te adjunto un código que forma parte de un sistema de bajada de correo automatico desde MsOutlook y manipulación del mismo. No es compilable tal cual, pero con pocos cambios lo pones a funcionar.

Code: Select all  Expand view

//-------------------------------------------------------------------------//
STATIC FUNCTION Contar(oPid)
Local nI, nJ
//Local oLeidos
Local cPathFileName, cFileName
Local oItem, oAttachment
Local aExcel:= {}, aWord:= {}
Local lHayXls, lHayWord
Local nPtesExcel:= 0
Local nPtesWord := 0
Local loApplication, lonamespace, loinbox, lncontador
Local lError
*
*
*
lError:= .f.
DO WHILE .T.
   loApplication:= ServerOutLook()
   IF loApplication == NIL
      MERROR_("(1) Se produjo un error !!", "Cierre MS-OutLook",;
              ole2txterror(), loApplication)
      LOOP
   ENDIF

   TRY
      loNameSpace   = loApplication:GetNameSpace("MAPI")
      TRY
         lonamespace:logon()
      CATCH

         MERROR_("(3) Se produjo un error !!", "Cierre MS-OutLook",;
                 ole2txterror(), lonamespace)
         lError:= .t.
      END
   CATCH
      MERROR_("(2) Se produjo un error !!", "Cierre MS-OutLook",;
              ole2txterror(), lonamespace)
      loApplication:Quit()
      lError:= .t.
   END
   IF !lError
      EXIT
   ENDIF
ENDDO


loInbox       = loNameSpace:GetDefaultFolder(6)

FOR lnContador:= 1 TO loInbox:items:Count

   oItem:= loinbox:items(lncontador)
   lHayXls:= .f.
   lHayWord:= .f.
   FOR nJ:= 1 TO oItem:attachments:Count
      oAttachment:= oitem:attachments:item(nJ)
      cFileName:= Upper(oAttachment:FileName)
      DO CASE
         CASE Right(cFileName, 4) == ".XLS"
            nPtesExcel++
         CASE Right(cFileName, 4) == ".RTF" .AND. "PEDIDO" $ cFileName
            nPtesWord++
      ENDCASE
   NEXT
   oItem:Close(0)
NEXT
lonamespace:logoff()
*
oPid:oVarExt:nPtesExcel:= nPtesExcel
oPid:oVarExt:nPtesWord := nPtesWord
*
RETURN NIL
*
//-------------------------------------------------------------------------//
STATIC FUNCTION ServerOutLook()
Local oServer
DO WHILE .t.

   TRY
      oServer:= GetActiveObject( "Outlook.Application" )
   CATCH
      TRY
          oServer:= CreateObject( "Outlook.Application" )
      CATCH
          oServer:= NIL
      END
   END
   EXIT
ENDDO
RETURN oServer
//-------------------------------------------------------------------------//
STATIC FUNCTION Imprimir(oPid)

Local nI, nJ, nK
Local oLeidos
Local cPathFileName, cFileName
Local oItem, oItem2, oAttachment
Local aExcel:= {}, aWord:= {}
Local lHayXls, lHayWord
Local loApplication, lonamespace, loinbox, lncontador
Local oSalida
Local aNames
*
IF oPid:oVarExt:lDentroImpresion
   RETURN NIL
ENDIF
oPid:oVarExt:lDentroImpresion:= .t.
*
TRY
   loApplication:= GetActiveObject( "Outlook.Application" )
CATCH
   TRY
       loApplication:= CreateObject( "Outlook.Application" )
   CATCH
       MERROR_( "Error !!! No esta instalado OutLook !!!", OLE2TXTERROR() )
   END
END

loNameSpace   = loApplication:GetNameSpace("MAPI")
lonamespace:logon()
loInbox       = loNameSpace:GetDefaultFolder(6)


oLeidos:= OutLookOpenCarpetaLeidos(loNameSpace)

oSalida:= loNameSpace:GetDefaultFolder(5)


FOR lnContador:= 1 TO loInbox:items:Count

   oItem:= loinbox:items(lncontador)
   lHayXls:= .f.
   lHayWord:= .f.
   aNames:= {}
   FOR nJ:= 1 TO oItem:attachments:Count
      oAttachment:= oitem:attachments:item(nJ)
      cFileName:= Upper(oAttachment:FileName)
      Aadd(aNames, oAttachment:FileName)
      DO CASE
         CASE Right(cFileName, 4) == ".XLS"
            cFileName:= StrTran(cFileName, Space(1), "") // Espacios de nombres largos
            // Le cambiamos el nombre por uno random pq las xls probablemente
            // tengan todas el mismo nombre.
            cPathFileName:= RandomFiGral(Left(cFileName, 4), ".xls", "Tmp")
            cPathFileName:= PathCompleto(cPathFileName)
            *
            oAttachment:SaveAsFile(cPathFileName)
            lHayXls:= .t.
            Aadd(aExcel, cPathFileName)
         CASE Right(cFileName, 4) == ".RTF" .AND. "PEDIDO" $ cFileName
            cFileName:= StrTran(cFileName, Space(1), "") // Espacios de nombres largos
            // Le cambiamos el nombre por uno random pq las xls probablemente
            // tengan todas el mismo nombre.
            cPathFileName:= RandomFiGral(Left(cFileName, 4), ".rtf", "Tmp")
            cPathFileName:= PathCompleto(cPathFileName)
            *
            oAttachment:SaveAsFile(cPathFileName)
            lHayWord:= .t.
            Aadd(aWord, cPathFileName)
      ENDCASE
   NEXT
   IF lHayXls .OR. lHayWord
      IF oPid:oVarExt:cAviRPC == "S"
         oItem2:= oItem:forward()
         *
         oItem2:To:= oItem2:SenderEmailAddress
         oItem2:Subject:= oemtoansi("Confirmado recepci¢n de su pedido "+;
                                     Arr2Cad(aNames))
         FOR nK:= 1 TO oItem2:attachments:Count
            oItem2:attachments:Remove(nK)
            nK--
         NEXT
         *
         oItem2:Send() //Move(oSalida)
      ENDIF
      oItem:Move(oLeidos)
      lnContador--           // importante: para que no se salte pq he movido el actual.
   ENDIF
   oItem:Close(0)
   *
   SysRefresh()
NEXT
lonamespace:logoff()
IF .t.
IF !Empty(aExcel)
   PrintExcel(aExcel)
ENDIF
IF !Empty(aWord)
   PrintWord(aWord)
ENDIF
ENDIF
oPid:oVarExt:lDentroImpresion:= .f.
RETURN NIL
*


//-------------------------------------------------------------------------//
STATIC FUNCTION PrintExcel(aFiles)
Local oExcel
Local nI
Local oBook
*
TRY
   oExcel:= GetActiveObject( "Excel.Application" )
CATCH
   TRY
       oExcel:= CreateObject( "Excel.Application" )
   CATCH
       MERROR_( "Error !!! No esta instalado Excel !!!", OLE2TXTERROR() )
   END
END

oExcel:Visible:= .f.
FOR nI:= 1 TO Len(aFiles)
   oExcel:WorkBooks:Open(aFiles[nI])
   oExcel:ActiveSheet:PrintOut()
   oExcel:WorkBooks:Close()
   DELETE FILE (aFiles[nI])
NEXT
oExcel:Quit()
RETURN NIL
*
//-------------------------------------------------------------------------//
STATIC FUNCTION PrintWord(aFiles)
Local oWord
Local nI
*
TRY
   oWord:= GetActiveObject( "Word.Application" )
CATCH
   TRY
       oWord:= CreateObject( "Word.Application" )
   CATCH
       MERROR_( "Error !!! No esta instalado Word !!!", OLE2TXTERROR() )
   END
END

oWord:Visible := .F.
FOR nI:= 1 TO Len(aFiles)
   oWord:Documents:Open(aFiles[nI])
   oWord:PrintOut()
   oWord:Documents:Close()
   DELETE FILE (aFiles[nI])
NEXT
oWord:Quit()
*
RETURN NIL
*

*
//-------------------------------------------------------------------------//
STATIC FUNCTION OutLookOpenCarpetaLeidos(loNameSpace)
Local oLeidos, oPersonales
oPersonales:= loNameSpace:Folders(1)

IF !OutLookExisteFolderPersonal(loNameSpace, CARPETA_LEIDOS)
   opersonales:folders:Add(CARPETA_LEIDOS)
ENDIF
oLeidos:= oPersonales:Folders(CARPETA_LEIDOS)

RETURN oLeidos
*
//-------------------------------------------------------------------------//
STATIC FUNCTION OutLookExisteFolderPersonal(loNameSpace, cFolder)
Local nI, oPersonales, lExiste:= .f.
Local oLeidos
oPersonales:= loNameSpace:Folders(1) //GetDefaultFolder(6)
FOR nI:= 1 to oPersonales:folders:Count
   oLeidos:= oPersonales:Folders(nI)
   IF oLeidos:Name == CARPETA_LEIDOS
      lExiste:= .t.
      EXIT
   ENDIF
NEXT
RETURN lExiste
*
*

 

Saludos

[FiveWiDi]

FiveWidi,

Te adjunto un código que forma parte de un sistema de bajada de correo automatico desde MsOutlook y manipulación del mismo. No es compilable tal cual, pero con pocos cambios lo pones a funcionar.

Saludos

Muchísimas gracias.

Es un buen punto de partida.

[jll-fwh]

Hola FiveWidi:

En las contribuciones de Harbour tienes como hacer lo que quieres, los ejemplos está en:

Code: Select all  Expand view

C:\harbour-3.0.0\contrib\hbtip

Un saludo
JLL

[FiveWiDi]

Hola a todos,

En el Hasrbour que trae FiveWin no viene C:\harbour-3.0.0\contrib\hbtip

¿ Por favor, quien me lo puede enviar ?

A este mail siperono@gelbla.com

Gracias.