Distro List and Attachment Lookup & Loop in VBA 1

[newestAF]

Ok, VBA is all new to me. Below is a code I've been able to edit to fit my need so far. What I'm trying to do is send several e-mails to different people. Each e-mail has a specific attachment(s) and different people depending on the attachment. I've built a table in my dbs with column 1 being attachment path and column 2 being the string of e-mails associated. Can anyone help me develop a script in addition to the below to get this to run with the click of a button? Thanks in advance.

Option Compare Database


Sub SendMessage(Optional Attachment)
Dim strEmail, strBody As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

strEmail = "[EMAIL ADDRESS]"

strBody = "FOR OFFICIAL USE ONLY. This electronic transmission contains personal information protected by the Privacy Act of 1974 (see AFI 33-332) and the Health Insurance Portability and Accountability Act (HIPAA) (see DoD6025.18-R) and is not intended for disclosure outside government channels and exempt from mandatory disclosure under the Freedom of Information Act, 5 U.S.C., 552. Exemption 6 may apply. Do not release outside of DoD channels without the consent of the originator's office. If you received this message in error, please notify the sender by reply e-mail and delete all copies of this message." & Chr(13) & Chr(13)
strBody = strBody & "FYI." & Chr(13) & Chr(13)
strBody = strBody & "V/R" & Chr(13) & Chr(13)
strBody = strBody & "//SIGNED//" & Chr(13) & Chr(13)
strBody = strBody & "NEIL E. WEST II, SSgt, USAF" & Chr(13) & Chr(13)
strBody = strBody & "NCOIC, PSM" & Chr(13) & Chr(13)
strBody = strBody & "DSN: 754-3253" & Chr(13) & Chr(13)
strBody = strBody & "COMM: 202-404-3253" & Chr(13) & Chr(13)


With MailOutLook
.To = "[email@domain]"
.CC = "[otheremail@domain]"
.Subject = "FOUO: Monthly Rosters"
.Body = strBody
.Importance = olImportanceHigh
.Sensitivity = olConfidential
.Attachments.Add "[Attachment Path]", olByValue, 1
.Display



End With

DriverExit:
On Error Resume Next
Set MailOutLook = Nothing
Set appOutLook = Nothing
Exit Sub

End Sub

 

[kjv1611]

So, it runs with no errors, and you just want it to perform behind a button?

If so,

[ol][li]If you've not created a form, create a user form[/li]
[li]Create a button on the user form[/li]
[li]Cancel out of any button wizard.[/li]
[li]Right-click the button, choose "Build event"
[li]In the VB Editor Window that comes up, enter one line inside the new Button_Click() event, so that it looks like the following:[/li][/ol]

Private Sub cmdClickMe()
[B]  SendMessage()[/B]
End Sub

--

"If to err is human, then I must be some kind of human!" -Me

 

[wemeier]

In the declarations area add the following:
[blue]
Dim db as Database
Dim rst as Recordset
[/[blue]]
In the body of your code, surround the With... statement with the following:
[blue]
Set db = Currentdb()
Set rst = db.OpenRecordset("[red]<tablename>[/red]")

While Not rst.EOF
[red]<this is where your "With" statement goes>[/red]
rst.MoveNext
Wend

rst.Close
Set db = Nothing
[/blue]
In your "With" statement, replace [red]"[email@domain]"[/red] (including the quotes) with [red]rst!<addresses>[/red] where [red]<addresses>[/red] is the name of the table field containing the addresses.

Also replace [red]"[Attachment Path]"[/red] (again, including the quotes) with [red]rst!<attachment>[/red] where [red]<attachment>[/red] is the name of your table field containing the attachment path.

What this coding will do is open your database table and walk the records. For each record it will construct an email containing the attachment and all of the addresses and send it. By the way, you don't need any coding to reference the "CC".

Cruising the Information Superhighway at the speed of light
_{(your mileage may vary)}

 

[newestAF]

Actually, I've already figured it out. Thanks though. You wouldn't happen to know how to active a .bat file using VBA script would you?

 

[TheAceMan1]

How are ya newestAF . . .

Start a new post! ... This way you'll be in full view of the forum

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[newestAF]

Not bad for a Monday morning. Having difficulty with upgrading my db. U?

 

[kjv1611]

newestAF,

Could you post here what it was that fixed your issue, so others will know?

Thanks

--

"If to err is human, then I must be some kind of human!" -Me

 

[newestAF]

Here you go.

****Start Code****

Option Compare Database

Sub SendMessage(Optional Attachment)


'This sets up the email address search. It will look up the email(s) located within the
'defined recordset and input into whatever specified field (i.e To or Cc or Bcc).


Dim cdb As DAO.Database
Dim rst As DAO.Recordset
Set cdb = CurrentDb
Set rst = cdb.OpenRecordset([Table Name])
rst.MoveFirst

'This is the beginning part of the loop. Everything from here will loop until the
'do until statement is true or false. In this case true.

Do Until rst.EOF

Dim strEmail
Dim MailOutLook As Object
Dim strTemplPath As String
Dim attachpath As String
Dim appoutlook As Outlook.Application

'set your variables and create email via template'
strTemplPath = DLookup([Field], [Table Name], [Primary Key])
Set appoutlook = CreateObject("Outlook.Application")
Set MailOutLook = appoutlook.CreateItemFromTemplate(strTemplPath)
attachpath = rst!Path


With MailOutLook
.To = rst!EMail
.CC = 'I have hard coded emails here'
.Attachments.Add attachpath
.Display


End With



rst.MoveNext

Loop


DriverExit:
On Error Resume Next
Set MailOutLook = Nothing
Set appoutlook = Nothing
Exit Sub

End Sub


****End Code****

Works great for what I need. Not bad for someone who started learning this 3 weeks ago.

 

[kjv1611]

For easy reference, where was the problem? Where was the change made? Maybe you can highlight it?

Thanks for posting.

--

"If to err is human, then I must be some kind of human!" -Me

 

[newestAF]

The fix is below.

When you set your variables, make sure to set your attachments path as

attachpath=rst!Path

where Path is the name of the field specified

Under "With" make sure to input

Attachments.Add attachpath

Do not put an "=" sign. Just one space and then the referenced variable. If you anyone is confused, please me know. Thanks.

 

[kjv1611]

Thanks for the follow-up.

--

"If to err is human, then I must be some kind of human!" -Me