array for email attachments?

  • Thread starter Thread starter joox
  • Start date Start date
J

joox

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 (e-mail address removed) -- 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: (e-mail address removed) C1: C:/file1.exe
A2: B2: C2: C:/file2.exe
A2: B3: (e-mail address removed) 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(xlCellTypeConstants)
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 said:
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 (e-mail address removed) -- 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: (e-mail address removed) C1: C:/file1.exe
A2: B2: C2: C:/file2.exe
A2: B3: (e-mail address removed) 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(xlCellTypeConstants)
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
 
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(xlCellTypeConstants)
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top