' Email everone in List their pdf
public sub button_click()
dim i as integer
dim itm
for i = 0 to lstBox.listcount -1
itm= lstBox.itemdata(i) 'get next item in listbox
lstBox = itm 'set the listbox to it
'collect the email,name ,etc
vID = lstbox.column(0)
vName = lstbox.column(1)
vEmail = lstbox.column(2)
vSubj = "your files
vBody = "Dear " & vName & vbcrlf & "Here are your files"
set colFiles = new collection
set colFiles = ScanFilesInDir(vID)
if colFiles.count > 0 then Email1PersonFiles vEmail, vSubj, vBody, colFiles
next
msgbox "Done"
set colFiles = nothing
end sub
'---------------
Public Function Email1PersonFiles(ByVal pvTo, ByVal pvSubj, ByVal pvBody, byval pcolFiles as collection) As Boolean
'---------------
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
dim vFile
On Error GoTo ErrMail
'************************
'YOU MUST ADD THE OUTLOOK APP IN REFERENCES!!! checkmark MICROSOFT OUTLOOK OBJECT LIBRARY in the VBE menu, Tools, References
'************************
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)
With oMail
.To = pvTo
.Subject = pvSubj
.Body = pvBody
for each vFile in pcolFiles
.Attachments.Add vFile
next
.Send
End With
EmailO = True
Set oMail = Nothing
Set oApp = Nothing
Exit Function
ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume Next
End Function
'---------------
Public function ScanFilesInDir(byval pvID) as collection
'---------------
Dim vFil, vTargT
Dim i As Integer
Dim fso
Dim oFolder, oFile
Dim vSrc
dim pvDir
dim colFiles as new collection
On Error GoTo errImp
pvDir = "c:\folder\" 'location of the pdf files
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(pvDir)
For Each oFile In oFolder.Files
vFil = pvDir & oFile.Name
'is ID string or numeric?
'vFind = "-" & pvID & "-" 'string
vFind = "-" & Format( pvID,"000" ) & "-" 'number
If InStr(vFil, ".pdf") > 0 and InStr(vFil, vFind) > 0 Then 'ONLY DO pdf files
vSrc = pvDir & oFile.Name
'get the file here, store in our collection to send
colFiles.add vSrc
End If
Next
set ScanFilesInDir = colfiles
Set fso = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Exit function
errImp:
MsgBox Err.Description, vbCritical, "clsImport:ImportData()" & Err
Exit function
Resume
End function
