FiveTech Software tech support forums

Code: Select all

//-------------------------------------------------------------------------//
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
*
*

 

Code: Select all

C:\harbour-3.0.0\contrib\hbtip