extract Outlook Attachments

[AUGE_OHR]

hi,

i want to extract Attachment from Outlook.
when run 1st time i also got all from Calender which is a Folder from Outlook so i have to exclude some Folder which are before "own" Folder

now i got it for German Version using this Code

Code: Select all

#include "HMG.ch"
#include "common.ch"
REQUEST HB_GT_WIN_DEFAULT           // Console

PROCEDURE MAIN
LOCAL oOutlook, cNameSpace, oWork, oFolder
LOCAL j,jMax,cName

   CLS

   SET ALTER TO FOLDER.TXT
   SET ALTER ON

   oOutlook := CreateObject( "Outlook.Application" )
   IF NIL == oOutlook
      MsgInfo( "Auf MS Outlook kann nicht zugegriffen werden. Bitte stellen Sie sicher,"  + ;
             Chr(13) + Chr(10 ) + "dass MS Outlook auf Ihrem Computer korrekt installiert ist.", "Fehler" )
      RETURN
   ENDIF

   cNameSpace  := oOutlook:GetNamespace( "MAPI" )
   oWork := cNameSpace:Folders(1)
   ?  cName := oWork:Name
   ? ""

   jMax := oWork:Folders:count
   FOR j := 1 TO jMax
      oFolder := oWork:Folders(j)
      ? cName := oFolder:Name

      DO CASE
         CASE cName = "Gelöschte Objekte"
         CASE cName = "Posteingang"
             SubFolder(oFolder)
         CASE cName = "Postausgang"
         CASE cName = "Gesendete Objekte"
         CASE cName = "Kalender"
         CASE cName = "Kontakte"
         CASE cName = "Journal"
         CASE cName = "Notizen"
         CASE cName = "Aufgaben"
         CASE cName = "Entwürfe"
         CASE cName = "RSS-Feeds"
         CASE cName = "Junk-E-Mail"
      OTHERWISE
          SubFolder(oFolder)
      ENDCASE
   NEXT

   SET ALTER OFF
   SET ALTER TO
RETURN

PROCEDURE SubFolder(oFolder)
RETURN

i know about Outlook Folder Constant

Code: Select all

#DEFINE olFolderDeletedItems                                                                 3
#DEFINE olFolderOutbox                                                                       4
#DEFINE olFolderSentMail                                                                     5
#DEFINE olFolderInbox                                                                        6
#DEFINE olFolderCalendar                                                                     9
#DEFINE olFolderContacts                                                                    10
#DEFINE olFolderJournal                                                                     11
#DEFINE olFolderNotes                                                                       12
#DEFINE olFolderTasks                                                                       13
#DEFINE olFolderDrafts                                                                      16

but it seems not to match with my DO CASE
need a Idea to make a International Version

[danielmaximiliano]

Jimmy: in VFP How to find the names of the folders within the inbox folder

Code: Select all

#DEFINE olFolderInBox 6
Local oOutlook,oNameSpace,oDefaultFolder
oOutlook=CREATEOBJECT('outlook.application')
oNameSpace=oOutlook.GetNamespace('mapi')
oDefaultFolder =oNameSpace.Getdefaultfolder(olFolderInBox)
oFolders=oDefaultFolder.folders
FOR EACH oFolder IN oFolders
 ?oFolder.name
ENDFOR

[AUGE_OHR]

Jimmy: in VFP How to find the names of the folders within the inbox folder

Code: Select all

#DEFINE olFolderInBox 6
Local oOutlook,oNameSpace,oDefaultFolder
oOutlook=CREATEOBJECT('outlook.application')
oNameSpace=oOutlook.GetNamespace('mapi')
oDefaultFolder =oNameSpace.Getdefaultfolder(olFolderInBox)
oFolders=oDefaultFolder.folders
FOR EACH oFolder IN oFolders
 ?oFolder.name
ENDFOR

THX, have try it but Code does not compile/link
i have change CLASS Syntax from "." to ":" and can compile/link but got only "." as Name

it is the normal Way to use Getdefaultfolder() with Constant but i want hole Tree while my Sub-Folder are not under olFolderInBox

Outlook_Email_Tree.JPG (68.01 KiB) Viewed 3681 times

but even if i get Name ... not sure if it is a Email-Folder while my Outlook show me "Kalender" or "Kontakt" also (which have no Attachment)

Get_Outlook_Attachment_1.jpg (121.68 KiB) Viewed 3681 times

Node in RED Box are create by Outlook other i have create.

but, like IPhone Device Sample, i have to include "more" if User have made "folders within the inbox folder"
THX for help

[danielmaximiliano]

Hi jimmy
I am not an Officce or Outlook user to be able to test the code, my Hotmail account started it in the browser from https://outlook.live.com/mail/0/inbox
At one time I used the outlookexpress application from a pirated installation

[danielmaximiliano]

Jimmy try this code ,, I was able to temporarily install outlook 2016 to use it in the CreateObject example

Code: Select all

#include "HMG.ch"
#include "common.ch"
#DEFINE olFolderInBox 6

REQUEST HB_GT_WIN_DEFAULT           // Console

PROCEDURE MAIN
LOCAL oOutlook, cNameSpace, oWork, oFolder, oDefaultFolder
LOCAL j, jMax, cName
    
   CLS
   SET ALTER TO FOLDER.TXT
   SET ALTER ON

   oOutlook := CreateObject( "Outlook.Application" )
   IF NIL == oOutlook
      MsgInfo( "Auf MS Outlook kann nicht zugegriffen werden. Bitte stellen Sie sicher,"  + ;
             Chr(13) + Chr(10 ) + "dass MS Outlook auf Ihrem Computer korrekt installiert ist.", "Fehler" )
      RETURN
   ENDIF

 
oNameSpace     := oOutlook:GetNamespace('mapi')
oDefaultFolder := oNameSpace:Getdefaultfolder(olFolderInBox)
oFolders       := oDefaultFolder:folders
FOR EACH oFolder IN oFolders
 ? oFolder:name
ENDFOR

[AUGE_OHR]

hi,

Jimmy try this code ,, I was able to temporarily install outlook 2016 to use it in the CreateObject example

it does not help while it use Constant "olFolderInBox"

how does your Original Outlook "Tree" look like

[danielmaximiliano]

hi,

i want to extract Attachment from Outlook.
need a Idea to make a International Version

Try

Code: Select all

#include "MiniGUI.ch"
#include "Common.CH"
#DEFINE nFolderDeletedItems    3
#DEFINE nFolderOutbox          4
#DEFINE nFolderSentMail        5
#DEFINE nFolderInbox           6
#DEFINE nFolderCalendar        9
#DEFINE nFoderContacts        10
#DEFINE nFolderJournal        11
#DEFINE nFolderNotes          12
#DEFINE nFolderTasks          13
#DEFINE nFolderDrafts         16


Function MAIN
LOCAL oOutlook, cNameSpace, oWork, oFolder, oDefaultFolder, oMapi, oFolderInbox, oItem, oItems
LOCAL nFor, nFolder, cName , nCounter
Local cFilename, Path
cPath := 'c:\savedattachments\'
    
   CLS
   SET ALTER TO FOLDER.TXT
   SET ALTER ON


   IF NIL == ( oOutlook := CreateObject( "Outlook.Application" ) )
      MsgInfo( "Auf MS Outlook kann nicht zugegriffen werden. Bitte stellen Sie sicher,"  + ;
             Chr(13) + Chr(10 ) + "dass MS Outlook auf Ihrem Computer korrekt installiert ist.", "Fehler" )
      RETURN
   ENDIF

 
oNameSpace     := oOutlook:GetNamespace( 'mapi' )
oFolderInbox   := oNameSpace:Getdefaultfolder( nFolderInbox )
oFolders       := oFolderInbox:folders
MsgInfo( oFolderInbox:UnReadItemCount , " UnReadItem   " )
nFolders       := oFolders:Count
 If nFolders > 0
 
   FOR nFor := 1 TO nFolders
      oFolder := oFolderInbox:Folders( nFor )
       MsgInfo( "Folder name: " + oFolder:Name )
   EndFor
 Else
 MsgInfo( "No Folders" , "Attention!!" )
EndIF
// Other Method
FOR EACH oFolder IN oFolders
 MsgInfo( "Folder name: " + oFolder:Name )
ENDFOR

//Save Attach 

oItems:= oNameSpace:GetDefaultFolder( nFolderInbox ):Items
For Each oItem In oItems
    If oItem:attachments:Count > 0  && Make sure there is an actual attachment.
        For nCounter = 1 To oItem:attachments:Count
            cFilename = Alltrim(cPath) + oItem:attachments:Item( nCounter ):filename
            oItem:attachments:Item( nCounter):SaveAsFile( cFilename )
           *oItem:Delete() && The option to delete the message once the attachment has been saved.
        Next
    Endif
Next


   SET ALTER OFF
   SET ALTER TO
 MsgInfo( "End Program"  )
RETURN

Work for My

[AUGE_OHR]

hi,

i got it so far to COPY Attachments from Outlook to Target Folder.

Outlook_Email_Tree03.jpg (75.63 KiB) Viewed 3596 times

after COPY i write *.INFO as Description.

now i try to "MOVE" Attachments but it seems not to REMOVE() Attachment from Outlook .. .
https://docs.microsoft.com/en-us/office ... nts.remove

while there is no Error i´m confused what is wrong ... need a Idea
i use this Code now

Code: Select all

   nStart := SECONDS()
   nMax := oFolder:items:count
   FOR n := 1 TO nMax
      oMailItem := oFolder:Items( n )

      bOldError := ERRORBLOCK( { | e | BREAK( e ) } )
      BEGIN SEQUENCE
         oAttachment := oMailItem:Attachments
         nCount := oAttachment:Count
      END SEQUENCE
      ERRORBLOCK( bOldError )

      IF nCount > 0
         cSubj := SUBSTR( oMailItem:Subject, 1, 80 ) + CRLF
         OLATTACH.List_Out.Additem( cSubj )

         i := 1
         FOR i := 1 TO nCount
            bOldError := ERRORBLOCK( { | e | BREAK( e ) } )
            BEGIN SEQUENCE
               oItem := oAttachment:Item( i )
               cName := oItem:DisplayName
               OLATTACH.List_Out.Additem( cName )
               nSum ++

               IF cCopyMove = "COPY" .OR. cCopyMove = "MOVE"
                  IF FILE( cOut + cName )
                     FERASE( cOut + cName )
                  ENDIF
                  oItem:SaveAsFile( cOut + cName )
               ENDIF

            END SEQUENCE
            ERRORBLOCK( bOldError )
         NEXT
        
         IF cCopyMove = "MOVE" 
           //  While myattachments.Count > 0 
           //     myattachments.Remove 1 
           //  Wend 
            DO WHILE oAttachment:Count > 0
               oAttachment:Remove(1)
            ENDDO
         ENDIF

         OLATTACH.List_Out.Additem( "----------------------------------" )
         OLATTACH.List_Out.Value := OLATTACH.List_Out.ItemCount

      ENDIF

      SetProperty( "OLATTACH", "ProgressBar_1", "Value", CalcPos( n, nMax ) )

   NEXT

   OLATTACH.ProgressBar_1.Value := 0
   nStop := SECONDS()

attached Demo how it work now

OLATTACH03.zip

(1.26 MiB) Downloaded 152 times

[danielmaximiliano]

Code: Select all

** If you want to look at a folder other than a default folder you could use the following code...

cFolder      := "Personal Folders"  **Top level Folder name
cMyFolder    := "Junk"                ** (case sensitive) change this to the folder you want
oObjectOpen  := ObjectOpen ("Outlook.Application")
oNameSpace   := oObjectOpen:GetNamespace("MAPI")
oFolders     := oNameSpace:Folders( cFolder )
oFolder      := oFolders:Folders( cMyFolder ); 
oCount       := objFolder:Items
nCount       := oCount:Count  **checks number of messages 
For nFor := 1 to nCount 
  oItem := oFolder:Items( nFor )
  cText := oItem:Body
  MsgInfo( "Message Body : "+ STR(xx) + CHR(10) + CRH( 13 );
            cText , cMyFolder )
Next
ObjectClose( oObjectOpen )
Return 

[danielmaximiliano]

Copy Work
Jimmy, do you want to delete all attachments after moving the downloaded files?
because I see that they are still in the inbox

See : https://www.extendoffice.com/documents/ ... -type.html

and
https://books.google.com.ar/books?id=8M ... t)&f=false