ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   array for email attachments? (https://www.excelbanter.com/excel-programming/330080-array-email-attachments.html)

joox

array for email attachments?
 

I have a column of email adresses(B) and a column of files(C) which need
to be attached in the emails. The spreadsheet shows that files in both
C1 and C2 need to go to -- but the script will not send the
email in the second row w/o an email address in there. This doesn't
seem like a problem, but some addresses have about 20 files and I dont
want to send them 20 separate emails... I'm guessing I need to setup an
array to facilitate the various numbers of attachements but I'm new at
this and don't know how!

Any help is appreciated,

MY SPREADSHEET:

Code:
--------------------

A1: B1:
C1: C:/file1.exe
A2: B2: C2: C:/file2.exe
A2: B3:
C3: C:/file3.exe

--------------------


THE CODE (PARTIAL):

Code:
--------------------
Set varOutApp = CreateObject("Outlook.Application")
Set varSendIt = varOutApp.CreateItem(0)

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants)
If cell.Offset(0, 1).Value < "" Then
If cell.Value < "" And Dir(cell.Offset(0, 1).Value) < "" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi "
.Attachments.Add cell.Offset(0, 1).Value
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

End Sub
--------------------


--
joox
------------------------------------------------------------------------
joox's Profile:
http://www.excelforum.com/member.php...o&userid=23711
View this thread: http://www.excelforum.com/showthread...hreadid=373880


[email protected]

array for email attachments?
 


joox wrote:
I have a column of email adresses(B) and a column of files(C) which need
to be attached in the emails. The spreadsheet shows that files in both
C1 and C2 need to go to -- but the script will not send the
email in the second row w/o an email address in there. This doesn't
seem like a problem, but some addresses have about 20 files and I dont
want to send them 20 separate emails... I'm guessing I need to setup an
array to facilitate the various numbers of attachements but I'm new at
this and don't know how!

Any help is appreciated,

MY SPREADSHEET:

Code:
--------------------

A1: B1:
C1: C:/file1.exe
A2: B2: C2: C:/file2.exe
A2: B3:
C3: C:/file3.exe

--------------------


THE CODE (PARTIAL):

Code:
--------------------
Set varOutApp = CreateObject("Outlook.Application")
Set varSendIt = varOutApp.CreateItem(0)

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants)
If cell.Offset(0, 1).Value < "" Then
If cell.Value < "" And Dir(cell.Offset(0, 1).Value) < "" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi "
.Attachments.Add cell.Offset(0, 1).Value
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

End Sub
--------------------


You don't need to use an array, you just have to change the logic of
your loop.
You loop should, starting at the top cell in B:

start of loop
If B is *not* blank then it's a new mail:
unless this is the first cell in B, we have the previous email
ready to _
_ send - send it
create a new email
endif
if C is *not* blank, then it's an attachment: attach it to current
email
increment the row we're working on
end of loop - exit if B + C are blank
send the current email we have ready

Iain


[email protected]

array for email attachments?
 
I've got some time now, so I can actually right some code.

Set varOutApp = CreateObject("Outlook.Application")
Set varSendIt = varOutApp.CreateItem(0)

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants)
If cell.Offset(0, 1).Value < "" Then
If cell.Value < "" And Dir(cell.Offset(0, 1).Value) < "" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi "
.Attachments.Add cell.Offset(0, 1).Value
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

End Sub
--------------------




Set varOutApp = CreateObject("Outlook.Application")
Set varSendIt = varOutApp.CreateItem(0)

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim row As long
dim currEmail as String, currFile as String

Const startRow = 1
Const emailCol = 2 'i.e. Column B
Const fileCol = 3 'i.e. Column C

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

row = startRow

Do
With Activesheet
currEmail = .cells(row, emailCol).value
currFile = .cells(row, fileCol).value
End With
If currEmail < "" Then 'new email address
If row startRow Then OutMail.Send
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = currEmail
.Subject = "Testfile"
.Body = "Hi "
End With
Endif
If currFile < "" Then 'an attachment
OutMail.Attachments.Add currFile
Endif
row = row + 1
Loop Until currEmail = "" and currFile = ""

OutMail.Send
Set OutMail = Nothing

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

--------------

I haven't tested this, so it might have a couple of mistakes in it.
You should be able to get the general idea though.

Iain


joox[_2_]

array for email attachments?
 

iain,

YOU ARE THE MAN!

THIS WORKS LIKE A CHARM!

*THANK YOU VERY MUCH!!!!

--
joo
-----------------------------------------------------------------------
joox's Profile: http://www.excelforum.com/member.php...fo&userid=2371
View this thread: http://www.excelforum.com/showthread.php?threadid=37388



All times are GMT +1. The time now is 05:49 PM.

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