Enviar mas de un archivo a traves de groupwise con condicion
Buenas noches desde el otro lado del charco.
Tengo terminada una macro que me envía una hoja de un libro por correo mediante groupwise.
Code:
OptionExplicit
Private ogwApp AsGroupwareTypeLibrary.Application
Private ogwRootAcct AsGroupwareTypeLibrary.accountSubEmail_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 GroupwareTypeLibrary
' -The following 2 lines declared at the beginning of the MODULE:
'Private ogwApp AsGroupwareTypeLibrary.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 Groupwiseobjectand login in to Groupwise
'Set application object reference if needed
If ogwApp Is Nothing Then 'Need to setobject reference
DoEvents
Set ogwApp =CreateObject("NovellGroupWareSession")
DoEvents
EndIf
If ogwRootAcct IsNothingThen'Need to log in
'Login to root account
IfLen(StrMailPassword)Then'Password was passed, so use it
sCommandOptions = "/pwd=" & StrMailPassword
Else 'Password was not passed
sCommandOptions = vbNullString
EndIf
Set ogwRootAcct = ogwApp.Login(StrLoginName, sCommandOptions, _
, egwPromptIfNeeded)
DoEvents
EndIf
'SECTION 4
'CreateandSend the Message
'Create new message
Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _
("GW.MESSAGE.MAIL", egwDraft)
DoEvents
'Assign"To" recipients
ForEach cl InSheets("Hoja1").Range("P1")
IfNot 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
IfNotStrBody=""Then.BodyText=StrBody
'Assign Attachment(s)
If Not strAttachFullPathName = "" Then .Attachments.Add strAttachFullPathName
'Send the message
OnErrorResumeNext
'Send method may fail if recipients don't resolve
.Send
DoEvents
OnErrorGoTo0
EndWith
'SECTION 5
'Release all variables
Set ogwNewMessage =Nothing
Set ogwRootAcct =Nothing
Set ogwApp =Nothing
DoEvents
'Sheets("Hoja1").Select
'Sheets("Hoja1").UnprotectPassword:="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"
EndSub
Con otra macro, cada vez que se ejecuta, guarda la hoja1 en una ruta fija, F:\
Queda constancia del nombre del archivo generado a partir del rango R2 (para posterior localizacion, ya tenemos ruta y nombre)
Dependiendo de los rangos R2:R8 son los archivo guardados y son los que quiero agregar al mensaje.
Si hay un solo archivo, funciona todo correcto.
Cuando hay varios archivos solo adjunta el ultimo creado.
Esta parte del codigo no me funciona:
Code:
IfSheets("Hoja1").Range("S1")=<1Then
Code:
StrSubject=Sheets("Hoja1").Range("A1")
Else
StrSubject=Sheets("Hoja1").Range("T1")
EndIf
Para que varie el asunto del mensaje, dependiendo si es un archivo a enviar o varios.
Gracias por vuestro tiempo.
