Option Explicit
Private ogwApp As GroupwareTypeLibrary.Application
Private ogwRootAcct As GroupwareTypeLibrary.Account
Sub Groupwise_SaveAttachToFile()
'Author : Ken Puls ([URL="http://www.excelguru.ca/"]www.excelguru.ca[/URL])
'Macro Purpose: Save all attachments of specified file type into a
'user specified folder using Groupwise
'NOTE: Reference to Groupware Type Libary required
'Object Model Documentation: [URL]http://www.novell.com/developer/GWDevGuide.pdf[/URL]
Dim ogwFolder As Folder, _
ogwFoundFolder As Folder, _
i As Long, _
sCommandOptions As String, _
sMailPassword As String, _
sLoginName As String, _
sFolderToSearch As String, _
sFileType As String, _
sSavePath As String, _
ogwMail As Mail
'Change required variables here!
sLoginName = "YourMailboxID"
sFolderToSearch = "FolderToLookIn"
sSavePath = "C:\Temp" 'do not add trailing \
sFileType = "xls"
'Set application object reference if needed
If ogwApp Is Nothing Then 'Need to set object reference
DoEvents
Set ogwApp = CreateObject("NovellGroupWareSession")
DoEvents
End If
'Create connection/login to email account
If ogwRootAcct Is Nothing Then 'Need to log in
'Login to root account
If Len(sMailPassword) Then 'Password was passed, so use it
sCommandOptions = "/pwd=" & sMailPassword
Else 'Password was not passed
sCommandOptions = vbNullString
End If
Set ogwRootAcct = ogwApp.Login(sLoginName, sCommandOptions, _
, egwPromptIfNeeded)
DoEvents
End If
'Search all mail items, and save any matching attachments to the
'specified directory
For Each ogwMail In ogwRootAcct.AllFolders.ItemByName(sFolderToSearch).Messages
With ogwMail
If .Attachments.Count = 0 Then
'No attachments, so do nothing
Else
'Attachments found. Save desired type to specified folder
For i = 1 To .Attachments.Count
If Right(.Attachments(i).Filename, 3) = sFileType Then
.Attachments(i).Save _
sSavePath & "\" & _
Format(.CreationDate, "yyyy-mm-dd") & " " & _
.Sender.DisplayName & " - " & _
.Attachments(i).Filename
End If
Next i
End If
End With
Next ogwMail
'Release all objects before closing
Set ogwRootAcct = Nothing
Set ogwApp = Nothing
DoEvents
End Sub