Let me see if I can explain this.....So I have a database that sends out emails as text messages to drivers and allows for attachments, which works fine. Currently all of the code in on the "Send" button, but I am trying to separate the code so when you click the Attachment check box you get the option to select the files and then you hit the "Send" button to send the email. Below is the code I have so far .
"Attachment" Check Box
And I want to pass the "colFiles" to the "Send" button below.
"Send" Button
Thanks in advance!
"Attachment" Check Box
Code:
Public Sub Check82_Click()
Dim FD As Object
Dim strName As String
If Check82 = True Then
Set FD = Application.FileDialog(3)
End If
Dim colFiles As New Collection
Dim vFile
If Check82 = True Then
FD.AllowMultiSelect = True
FD.Filters.Clear
FD.Filters.Add "All Files", "*.jpg, *.gif, *.tif, *.png"
FD.InitialFileName = strName
If FD.Show = True Then
FD.InitialView = 6
For Each vrtSelectedItem In FD.SelectedItems
colFiles.Add vrtSelectedItem
Next
End If
End If
End Sub
And I want to pass the "colFiles" to the "Send" button below.
"Send" Button
Code:
Private Sub btnMsgYard_Click()
DoCmd.SetWarnings False
DoCmd.OpenQuery "delDriverMessage", acViewNormal, acEdit
If Check82 = True Then
DoCmd.OpenQuery "apdDriverMessageMMS", acViewNormal, acEdit
Else
DoCmd.OpenQuery "apdDriverMessage", acViewNormal, acEdit
End If
DoCmd.SetWarnings True
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT Driver, CellExt FROM tblDriverMessage"
Set rs = db.OpenRecordset(strSQL)
rs.MoveFirst
Do Until rs.EOF
Dim MyRs As DAO.Recordset
Dim strAddr
Dim strSubject
Dim strBody
Dim oOutlook As Object
Dim oEmailItem As Object
With MyRs
strAddr = rs.Fields("CellExt")
strSubject = "Sysco"
If IsNull(Text31) Then
strBody = ""
Else
strBody = Text31
End If
Set oOutlook = GetObject(, "Outlook.Application")
If oOutlook Is Nothing Then Set oOutlook = CreateObject("Outlook.Application")
Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem
.To = strAddr
.Subject = strSubject
.Body = strBody
'************ Pass colFiles here
If Check82 = True Then
For Each vFile In colFiles
.Attachments.Add vFile, olByValue, 1
Next
End If
'************ Pass colFiles Here
.send
End With
Set oEmailItem = Nothing
Set oOutlook = Nothing
End With
rs.MoveNext
Loop
Set rs = Nothing
Set db = Nothing
Image6.Visible = True
Text31 = Null
Check82 = False
End Sub
Thanks in advance!