ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Array of files (https://www.excelbanter.com/excel-programming/340059-array-files.html)

Chad[_12_]

Array of files
 
This code I found somewhere on the net and it works a treat for sending
one attachment to multiple recipients within a Lotus Notes environment.

It would be more practical to have the email names in Col A and have it
send more than one attachment with the corresponding file name and path
in Col B. I have to send out about 10 different attachments. Is this
possible with an array of some sort? Any help would be most
appreciated as I am all searched out and I usually find what I am
after.

Thanks

Chad


Sub SendLotusNote()

' be sure to reference the Lotus Domino Objects, domobj.tlb
Dim objNotesSession As Object
Dim objNotesDatabase As Object
Dim objNotesDocument As Object
Dim objAttachment As Object
Dim objRichText As Object
Dim FullPath As String
Dim FileName As String
Dim Msg As String

Const EMBED_ATTACHMENT = 1454

Set objNotesSession = CreateObject("Notes.Notessession")
Set objNotesDatabase = objNotesSession.GetDatabase("*", "")
Call objNotesDatabase.OpenMail 'default mail database
If objNotesDatabase.IsOpen = False Then
MsgBox "Cannot connect to Lotus Notes."
Exit Sub
End If
Set objNotesDocument = objNotesDatabase.CreateDocument
Call objNotesDocument.ReplaceItemValue("Form", "Memo")
ActiveWorkbook.Save
FullPath = Range("B1").Value ' file to send lives here
' assemble message
Set objRichText = objNotesDocument.CreateRichTextItem("Body")
Set objAttachment = objRichText.EmbedObject(EMBED_ATTACHMENT, "",
FullPath)
Msg = "Lotus Note sent from " & objNotesSession.CommonUserName
With objNotesDocument
.Subject = ""
.body = Msg
.SendTo = ", ",
")
.SaveMessageOnSend = True ' save in Sent folder
.Send (False)
End With

Set objNotesSession = Nothing
Set objNotesDatabase = Nothing
Set objNotesDocument = Nothing
Set objAttachment = Nothing
Set objRichText = Nothing

End Sub


Bob Phillips[_6_]

Array of files
 
Suggestion

Change

.SendTo = ", ")

to

Dim aryAddys()

aryAddys = Range("A1:A100")
.SendTo = aryAddys

may not work as it is a 2d array, but I cannot test it.


--
HTH

Bob Phillips

"Chad" wrote in message
ups.com...
This code I found somewhere on the net and it works a treat for sending
one attachment to multiple recipients within a Lotus Notes environment.

It would be more practical to have the email names in Col A and have it
send more than one attachment with the corresponding file name and path
in Col B. I have to send out about 10 different attachments. Is this
possible with an array of some sort? Any help would be most
appreciated as I am all searched out and I usually find what I am
after.

Thanks

Chad


Sub SendLotusNote()

' be sure to reference the Lotus Domino Objects, domobj.tlb
Dim objNotesSession As Object
Dim objNotesDatabase As Object
Dim objNotesDocument As Object
Dim objAttachment As Object
Dim objRichText As Object
Dim FullPath As String
Dim FileName As String
Dim Msg As String

Const EMBED_ATTACHMENT = 1454

Set objNotesSession = CreateObject("Notes.Notessession")
Set objNotesDatabase = objNotesSession.GetDatabase("*", "")
Call objNotesDatabase.OpenMail 'default mail database
If objNotesDatabase.IsOpen = False Then
MsgBox "Cannot connect to Lotus Notes."
Exit Sub
End If
Set objNotesDocument = objNotesDatabase.CreateDocument
Call objNotesDocument.ReplaceItemValue("Form", "Memo")
ActiveWorkbook.Save
FullPath = Range("B1").Value ' file to send lives here
' assemble message
Set objRichText = objNotesDocument.CreateRichTextItem("Body")
Set objAttachment = objRichText.EmbedObject(EMBED_ATTACHMENT, "",
FullPath)
Msg = "Lotus Note sent from " & objNotesSession.CommonUserName
With objNotesDocument
.Subject = ""
.body = Msg
.SendTo = ", ",
")
.SaveMessageOnSend = True ' save in Sent folder
.Send (False)
End With

Set objNotesSession = Nothing
Set objNotesDatabase = Nothing
Set objNotesDocument = Nothing
Set objAttachment = Nothing
Set objRichText = Nothing

End Sub



Alan Beban[_2_]

Array of files
 
Bob Phillips wrote:
Suggestion

Change

.SendTo = ", ")

to

Dim aryAddys()

aryAddys = Range("A1:A100")
.SendTo = aryAddys

may not work as it is a 2d array, but I cannot test it.


aryAddys = Application.Transpose(Range("A1:A100")) will produce a 1-D array

Alan Beban

Chad[_12_]

Array of files
 
Hi

Thanks this works perfectly. I can now have as many email addresses as
I wish attaching a single file. I tried to alter the code to have an
array refer to the corresponding file in Col B so I can attach multiple
files but it has been failing. Is there something obviously wrong with
the code?

Thanks

Chad

Sub SendLotusNote()

' be sure to reference the Lotus Domino Objects, domobj.tlb
Dim objNotesSession As Object
Dim objNotesDatabase As Object
Dim objNotesDocument As Object
Dim objAttachment As Object
Dim objRichText As Object
Dim FullPath As String
Dim FileName As String
Dim Msg As String
Dim aryAddys()
Dim myAry()

Const EMBED_ATTACHMENT = 1454

Set objNotesSession = CreateObject("Notes.Notessession")
Set objNotesDatabase = objNotesSession.GetDatabase("*", "")
Call objNotesDatabase.OpenMail 'default mail database
If objNotesDatabase.IsOpen = False Then
MsgBox "Cannot connect to Lotus Notes."
Exit Sub
End If
Set objNotesDocument = objNotesDatabase.CreateDocument
Call objNotesDocument.ReplaceItemValue("Form", "Memo")
ActiveWorkbook.Save
'Following 2 lines holt code.
myAry = Range("B1:B100")
FullPath = myAry 'does not like this.
' FullPath = Range("A1").Value '(original C wks fine)
' assemble message
Set objRichText = objNotesDocument.CreateRichTextItem("Body")
Set objAttachment = objRichText.EmbedObject(EMBED_ATTACHMENT, "",
FullPath)
Msg = "Lotus Note sent from " & objNotesSession.CommonUserName
With objNotesDocument
.Subject = ""
.body = Msg
aryAddys = Range("B1:B100")
.SendTo = aryAddys
.SaveMessageOnSend = True ' save in Sent folder)
.Send (False)
End With

Set objNotesSession = Nothing
Set objNotesDatabase = Nothing
Set objNotesDocument = Nothing
Set objAttachment = Nothing
Set objRichText = Nothing

End Sub


Bob Phillips[_6_]

Array of files
 
I think you would need to loop reading all files and embedding them one at a
time.

--
HTH

Bob Phillips

"Chad" wrote in message
ups.com...
Hi

Thanks this works perfectly. I can now have as many email addresses as
I wish attaching a single file. I tried to alter the code to have an
array refer to the corresponding file in Col B so I can attach multiple
files but it has been failing. Is there something obviously wrong with
the code?

Thanks

Chad

Sub SendLotusNote()

' be sure to reference the Lotus Domino Objects, domobj.tlb
Dim objNotesSession As Object
Dim objNotesDatabase As Object
Dim objNotesDocument As Object
Dim objAttachment As Object
Dim objRichText As Object
Dim FullPath As String
Dim FileName As String
Dim Msg As String
Dim aryAddys()
Dim myAry()

Const EMBED_ATTACHMENT = 1454

Set objNotesSession = CreateObject("Notes.Notessession")
Set objNotesDatabase = objNotesSession.GetDatabase("*", "")
Call objNotesDatabase.OpenMail 'default mail database
If objNotesDatabase.IsOpen = False Then
MsgBox "Cannot connect to Lotus Notes."
Exit Sub
End If
Set objNotesDocument = objNotesDatabase.CreateDocument
Call objNotesDocument.ReplaceItemValue("Form", "Memo")
ActiveWorkbook.Save
'Following 2 lines holt code.
myAry = Range("B1:B100")
FullPath = myAry 'does not like this.
' FullPath = Range("A1").Value '(original C wks fine)
' assemble message
Set objRichText = objNotesDocument.CreateRichTextItem("Body")
Set objAttachment = objRichText.EmbedObject(EMBED_ATTACHMENT, "",
FullPath)
Msg = "Lotus Note sent from " & objNotesSession.CommonUserName
With objNotesDocument
.Subject = ""
.body = Msg
aryAddys = Range("B1:B100")
.SendTo = aryAddys
.SaveMessageOnSend = True ' save in Sent folder)
.Send (False)
End With

Set objNotesSession = Nothing
Set objNotesDatabase = Nothing
Set objNotesDocument = Nothing
Set objAttachment = Nothing
Set objRichText = Nothing

End Sub




All times are GMT +1. The time now is 02:47 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com