I have a program which download lotus attachment to a path in computer. It does not download the file when the file is already downloaded. But if we delete the file from path, it downloads it again. I have a workaround, that we can mark the file as read when downloaded, but don't know how to achieve this. How can i get this to work? Please suggest.
Option Explicit
Dim TimeToRun
Public RunWhen As Double
Const cRunInvtSecs = 10
Const cRunWhat = "Sheet1.Save_Attachments_Remove_Emails"
Sub StartTimer()
'MsgBox ("Hello 1")
RunWhen = Now + TimeSerial(0, 0, cRunInvtSecs)
'MsgBox (RunWhen)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, Schedule:=True
'Call Save_Attachments_Remove_Emails
End Sub
Sub Save_Attachments_Remove_Emails()
'MsgBox ("Hello 2")
Const stPath As String = "c:\Attachments\"
Const EMBED_ATTACHMENT As Long = 1454
Const RICHTEXT As Long = 1
Dim noSession As Object
Dim noDatabase As Object
Dim noView As Object
Dim noDocument As Object
Dim noRemoveDocument As Object
Dim noNextDocument As Object
'Embedded objects are of the datatype Variant.
Dim vaItem As Variant
Dim vaAttachment As Variant
'Instantiate the Notes session.
Set noSession = CreateObject("Notes.NotesSession")
'Instantiate the actual Notes database.
'(Here is the personal e-mail database used and since it's a
'local database no reference is made to any server.)
Set noDatabase = noSession.GETDATABASE("CAT-DH-23.apd.cat.com/Servers/Caterpillar", "mail\pamsmine.nsf")
' Please use this Open Function if the server is not referenced and GETDATABASE
' opens the db file if the file is in local system.
'Call noDatabase.Open("", "C:\notes\test.nsf")
'Folders are views in Lotus Notes and in this example the Inbox
'is used.
Set noView = noDatabase.GetView("($Inbox)")
'Get the first document in the defined view.
Set noDocument = noView.GetFirstDocument
'Iterate through all the e-mails in the view Inbox.
Do Until noDocument Is Nothing
Set noNextDocument = noView.GetNextDocument(noDocument)
'Check if the document has an attachment or not.
If noDocument.HasEmbedded Then
Set vaItem = noDocument.GetFirstItem("Body")
If vaItem.Type = RICHTEXT Then
For Each vaAttachment In vaItem.EmbeddedObjects
If vaAttachment.Type = EMBED_ATTACHMENT Then
' ...check if was downloaded.
If Dir(stPath & vaAttachment.Name) = "" Then
'Save the attached file into the new folder.
vaAttachment.ExtractFile stPath & vaAttachment.Name
'Set the e-mail object which will be deleted.
' Set noRemoveDocument = noDocument
End If
End If
Next vaAttachment
End If
End If
Set noDocument = noNextDocument
'Delete the e-mails which have an attached file.
' If Not noRemoveDocument Is Nothing Then
' noRemoveDocument.Remove (True)
' Set noRemoveDocument = Nothing
'End If
Loop
'Release objects from memory.
Set noRemoveDocument = Nothing
Set noNextDocument = Nothing
Set noDocument = Nothing
Set noView = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'MsgBox "All the attachments in the Inbox have successfully been saved" & vbCrLf & _
"and the associated e-mails have successfully been deleted.", vbInformation
Call StartTimer
End Sub
Sub auto_close()
Application.OnTime TimeToRun, "Save_Attachments_Remove_Emails", , False
End Sub
Option Explicit
Dim TimeToRun
Public RunWhen As Double
Const cRunInvtSecs = 10
Const cRunWhat = "Sheet1.Save_Attachments_Remove_Emails"
Sub StartTimer()
'MsgBox ("Hello 1")
RunWhen = Now + TimeSerial(0, 0, cRunInvtSecs)
'MsgBox (RunWhen)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, Schedule:=True
'Call Save_Attachments_Remove_Emails
End Sub
Sub Save_Attachments_Remove_Emails()
'MsgBox ("Hello 2")
Const stPath As String = "c:\Attachments\"
Const EMBED_ATTACHMENT As Long = 1454
Const RICHTEXT As Long = 1
Dim noSession As Object
Dim noDatabase As Object
Dim noView As Object
Dim noDocument As Object
Dim noRemoveDocument As Object
Dim noNextDocument As Object
'Embedded objects are of the datatype Variant.
Dim vaItem As Variant
Dim vaAttachment As Variant
'Instantiate the Notes session.
Set noSession = CreateObject("Notes.NotesSession")
'Instantiate the actual Notes database.
'(Here is the personal e-mail database used and since it's a
'local database no reference is made to any server.)
Set noDatabase = noSession.GETDATABASE("CAT-DH-23.apd.cat.com/Servers/Caterpillar", "mail\pamsmine.nsf")
' Please use this Open Function if the server is not referenced and GETDATABASE
' opens the db file if the file is in local system.
'Call noDatabase.Open("", "C:\notes\test.nsf")
'Folders are views in Lotus Notes and in this example the Inbox
'is used.
Set noView = noDatabase.GetView("($Inbox)")
'Get the first document in the defined view.
Set noDocument = noView.GetFirstDocument
'Iterate through all the e-mails in the view Inbox.
Do Until noDocument Is Nothing
Set noNextDocument = noView.GetNextDocument(noDocument)
'Check if the document has an attachment or not.
If noDocument.HasEmbedded Then
Set vaItem = noDocument.GetFirstItem("Body")
If vaItem.Type = RICHTEXT Then
For Each vaAttachment In vaItem.EmbeddedObjects
If vaAttachment.Type = EMBED_ATTACHMENT Then
' ...check if was downloaded.
If Dir(stPath & vaAttachment.Name) = "" Then
'Save the attached file into the new folder.
vaAttachment.ExtractFile stPath & vaAttachment.Name
'Set the e-mail object which will be deleted.
' Set noRemoveDocument = noDocument
End If
End If
Next vaAttachment
End If
End If
Set noDocument = noNextDocument
'Delete the e-mails which have an attached file.
' If Not noRemoveDocument Is Nothing Then
' noRemoveDocument.Remove (True)
' Set noRemoveDocument = Nothing
'End If
Loop
'Release objects from memory.
Set noRemoveDocument = Nothing
Set noNextDocument = Nothing
Set noDocument = Nothing
Set noView = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'MsgBox "All the attachments in the Inbox have successfully been saved" & vbCrLf & _
"and the associated e-mails have successfully been deleted.", vbInformation
Call StartTimer
End Sub
Sub auto_close()
Application.OnTime TimeToRun, "Save_Attachments_Remove_Emails", , False
End Sub