Attach more than one archive in email using groupwise.

[COLOR=#666666][FONT=Consolas]Option Explicit
[/FONT][/COLOR][COLOR=#666666][FONT=Consolas]Private ogwApp As GroupwareTypeLibrary.Application
[/FONT][/COLOR][COLOR=#666666][FONT=Consolas]Private ogwRootAcct As GroupwareTypeLibrary.account[/FONT][/COLOR]
Sub Email_Multiple_Users_Via_Groupwise()
'Macro purpose: To stand as a self contained procedure for creating and
'sending an email to multiple users (if required)
'This code requires:
' -A reference to the Groupware Type Library
' -The following 2 lines declared at the beginning of the MODULE:
' Private ogwApp As GroupwareTypeLibrary.Application
' Private ogwRootAcct As GroupwareTypeLibrary.account
' -The following named ranges on the spreadsheet
' Email_To
' Email_CC
' Email_BC
'SECTION 1
'Declare all required variables
Const NGW$ = "NGW"
Dim lRpta
Dim ogwNewMessage As GroupwareTypeLibrary.Mail
StrLoginName As String, _
StrMailPassword As String, _
StrSubject As String, _
StrBody As String, _
strAttachFullPathName As String, _
sCommandOptions As String, _
cl As Range
'SECTION 2
'Set all required variables
StrLoginName = "mi email" 'Enter your mailbox ID here
StrMailPassword = "" 'A true password is not required
If Sheets("Hoja1").Range("S1") = "" Then
StrSubject = Sheets("Hoja1").Range("A1")
Else
StrSubject = Sheets("Hoja1").Range("T1")
End If
StrBody = "Buenos Días" & vbCrLf & _
"VIctor"
strAttachFullPathName = "F:/" & Sheets("Hoja1").Range("A1") & ".xlsm" 'Put full path of workbook to be attached between quotes.
'SECTION 3
'Create the Groupwise object and login in to Groupwise
'Set application object reference if needed
If ogwApp Is Nothing Then 'Need to set object reference
DoEvents
Set ogwApp = CreateObject("NovellGroupWareSession")
DoEvents
End If
If ogwRootAcct Is Nothing Then 'Need to log in
'Login to root account
If Len(StrMailPassword) Then 'Password was passed, so use it
sCommandOptions = "/pwd=" & StrMailPassword
Else 'Password was not passed
sCommandOptions = vbNullString
End If
Set ogwRootAcct = ogwApp.Login(StrLoginName, sCommandOptions, _
, egwPromptIfNeeded)
DoEvents
End If
'SECTION 4
'Create and Send the Message
'Create new message
Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _
("GW.MESSAGE.MAIL", egwDraft)
DoEvents
'Assign "To" recipients
For Each cl In Sheets("Hoja1").Range("P1")
If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwTo
Next cl
With ogwNewMessage
'Asign the SUBJECT text
If Not StrSubject = "" Then .Subject = Sheets("Hoja1").Range("A1")
'Assign the BODY text
If Not StrBody = "" Then .BodyText = StrBody
'Assign Attachment(s)
If Not strAttachFullPathName = "" Then .Attachments.Add strAttachFullPathName
'Send the message
On Error Resume Next
'Send method may fail if recipients don't resolve
.Send
DoEvents
On Error GoTo 0
End With
'SECTION 5
'Release all variables
Set ogwNewMessage = Nothing
Set ogwRootAcct = Nothing
Set ogwApp = Nothing
DoEvents
'Sheets("Hoja1").Select
'Sheets("Hoja1").Unprotect Password:="password"
' Borramos area de impresion anterior:
'ActiveSheet.PageSetup.PrintArea = ""
'Definimos nueva area de impresion seleccionando el contenido
'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
'ActiveSheet.PageSetup.PrintArea = "$A$1:$M$152"
'Sheets("Hoja1").PrintOut
'Sheets("Hoja1").Protect Password:="password"
' MsgBox "COPIA CREADA, CORREO ENVIADO E IMPRIMIDO EN PAPEL"End Sub[COLOR=#222222][FONT=Verdana]

[COLOR=#666666][FONT=Arial]Range("R65536").End(xlUp).Offset(1, 0) = Range("A1")[/FONT][/COLOR]

[COLOR=#666666][FONT=Consolas]If Sheets("Hoja1").Range("S1") = "" Then[/FONT][/COLOR]
StrSubject = Sheets("Hoja1").Range("S1")
Else
StrSubject = Sheets("Hoja1").Range("T1")
[COLOR=#666666][FONT=Consolas]End If[/FONT][/COLOR]