Is it possible to drop over a FWH window email messages draging it directly from Outlook ou Outlook express ?
Antonio
ACTIVATE DIALOG oDlg ON INIT DropFiles( oDlg )
FUNCTION DropFiles( oDlg )
DragAcceptFiles( oDlg:hWnd, .T. )
oDlg:bDropFiles := { | nRow, nCol, aFiles | MSgInfo( aFiles[1] ) }
RETURN (.T.)
Sub SaveEmail()
Dim myItems, myItem As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
myOrt = "c:\whoLIMP\"
On Error Resume Next
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'for all items do...
For Each myItem In myOlSel
myItem.SaveAs myOrt & "xxxx.txt", olTXT
myItem.SaveAs myOrt & myItem.EntryID & ".txt", olTXT
myItem.SaveAs myOrt & myItem.EntryID & ".msg", olMSG
'myItem.Delete
Next
'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
#include "fivewin.ch"
function main()
local oWnd, oTmr
DEFINE WINDOW oWnd TITLE "Dokumentenmanagement - elektronische Archivierung" ;
FROM 0.4,0.8 TO 8,30 ;
SETWINDOWPOS( oWnd:hWnd, -1, 0, 0, 0, 0, 3 )
DEFINE TIMER oTmr INTERVAL 2000 ACTION OutlookEmail( oTmr,oWnd ) OF oWnd
ACTIVATE TIMER oTmr
ACTIVATE WINDOW oWnd
return nil
function OutlookEmail( oTmr,oWnd )
local cDir := ""
local aDirServ := {}
local IDirServ := 0
local cDatei := ""
local cAufruf := "Outlook"
local cEmaildmsdbf := ""
local cNotiz := ""
local Emaildmsdbf := ""
*--------------------------------------------------------------------------
oTmr:Deactivate()
cDir := "c:\whOlImp"
if lIsDir(cDir) = .F.
lMKDir(cDir)
endif
cDir := cDir + "\"
aDirServ := directory(cDir + "*.msg", "D")
FOR IDirServ := 1 TO len(aDirServ)
cDatei := cdir + aDirServ[IDirServ,1]
cEmaildmsdbf := MemoRead("c:\whOlImp\xxxx.txt")
Emaildmsdbf := substr(cEmaildmsdbf,AT("Betreff:",cEmaildmsdbf))
cNotiz := left(ALLTRIM(substr(cEmaildmsdbf,10)),1000)
msginfo( Emaildmsdbf + CRLF+CRLF+cNotiz )
ferase(cDatei)
oWnd:END()
next
oTmr:Activate()
return nil
//----------------------------------------------------------------------------//
Sub SaveEmail()
Dim myItems, myItem As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim anhang As Outlook.Attachment
myOrt = "c:\whoLIMP\"
On Error Resume Next
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'for all items do...
For Each myItem In myOlSel
myItem.SaveAs myOrt & "xxxx.txt", olTXT
myItem.SaveAs myOrt & myItem.EntryID & ".txt", olTXT
myItem.SaveAs myOrt & myItem.EntryID & ".msg", olMSG
For Each anhang In myItem.Attachments
anhang.SaveAsFile myOrt & mail & "_" & anhang.FileName
'MsgBox (anhang.DisplayName)
Next
'myItem.Delete
Next
'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
#define olFolderInbox 6
//----------------------------------------------------------------//
function Main()
LOCAL oOutlook := CREATEOBJECT( "Outlook.Application" )
LOCAL oNameSpace := oOutlook:GetNameSpace("MAPI")
LOCAL oInbox := oNameSpace:GetDefaultFolder( olFolderInbox )
LOCAL i , oItems
LOCAL ioMail
local myItem
// ?local oItems1 := createOleObject( "oOutlook.ActiveExplorer.Selection" )
// ?local oInbox := oOutlook.CurrentFolder("get" )
// ?local myOlExp := createOleObject( "oOutlook.ActiveExplorer" )
msginfo( oInbox:name() )
msginfo( oNameSpace:GetDefaultFolder(6):Folders:Count)
For i = 1 TO oNameSpace:GetDefaultFolder(6):Folders:Count
msginfo(oNameSpace:GetDefaultFolder(6):Folders[ i ]:name)
msginfo(oNameSpace:GetDefaultFolder(6):Folders[ i ]:Items:Count)
For ioMail = 1 to oNameSpace:GetDefaultFolder(6):Folders[ i ]:Items:Count
myItem := oNameSpace:GetDefaultFolder(6):Folders[ i ]:Items[ ioMail ]
// msginfo( myItem:SenderName)
// msginfo( oNameSpace:GetDefaultFolder(6):Folders[ i ]:Items[ ioMail ]:Subject)
// msginfo( oNameSpace:GetDefaultFolder(6):Folders[ i ]:Items[ ioMail ]:To)
// msginfo( oNameSpace:GetDefaultFolder(6):Folders[ i ]:Items[ ioMail ]:Body)
// msginfo (myItem:EntryID & ".msg")
myItem:SaveAs ( "c:\temp\" + ALLTRIM(str(ioMail)) + "demo.msg" )
Next
Next
oOutlook:Quit()
RETURN NIL
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 86 guests