PDA

View Full Version : Send email with PDF attachments from Outlook 2013



stogdengys
06-02-2015, 09:55 PM
Hi,

I need to send an email with all pdf files as attachments from specified folder. So far i have the code that sends only one file. Can you help me?

Sub Send_Click()

Dim msg As Outlook.MailItem
Set msg = Application.CreateItem(olMailItem)
msg.Subject = "Hello World!"
msg.To = "yyyy.com"
msg.Attachments.Add "c:\Users\pc\Desktop\123.pdf", olByValue, 2, "test"

msg.send
Set msg = Nothing
End Sub

gmayor
06-03-2015, 12:51 AM
You need to loop through the pdf files in the named folder (here C:\Users\pc\Desktop\) as in your original macro e.g.


Option Explicit

Sub Send_Click()

Dim olMsg As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim olAtt As Attachment
Dim strFilename As String
Const strPath As String = "C:\Users\pc\Desktop\"
Set olMsg = Application.CreateItem(olMailItem)
With olMsg
.Subject = "Hello World!"
.To = "yyyy.com"
strFilename = Dir$(strPath & "*.pdf")
While Len(strFilename) <> 0
.Attachments.Add strPath & strFilename, olByValue
strFilename = Dir$()
Wend
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
.Display 'required to edit body
oRng.Text = "This is the message body text."
'.sEnd 'restore after testing
End With
lbl_Exit:
Set olMsg = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub

stogdengys
06-03-2015, 01:30 AM
You are the King! Thank you. Perfect! I just added IF to check if there is some attachments to send and give a MSGBOX.


If .Attachments.count < 1 Then
MsgBox "No Items to Send"
Else
.send


Option Explicit

Sub Send_Click()

Dim olMsg As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim olAtt As Attachment
Dim strFilename As String
Const strPath As String = "C:\Users\pc\Desktop\"
Set olMsg = Application.CreateItem(olMailItem)
With olMsg
.Subject = "Hello World!"
.To = "yyyy.com"
strFilename = Dir$(strPath & "*.pdf")
While Len(strFilename) <> 0
.Attachments.Add strPath & strFilename, olByValue
strFilename = Dir$()
Wend
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
.Display 'required to edit body
oRng.Text = "This is the message body text."
If .Attachments.count < 1 Then
MsgBox "No Items to Send"
Exit Sub
Else
.send

End With
lbl_Exit:
Set olMsg = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub

gmayor
06-03-2015, 03:52 AM
Instead of Exit Sub in your addition use

Goto lbl_Exit

stogdengys
06-03-2015, 05:51 AM
Thank you. And one more thing i would like to do: I want to check if there is any files (not folders) in my directory. In my case, If there is no files in G:\korteles\ISSUING\Reps\, than exit sub without creating email. So far i have this modified code:


Sub Send()
Dim Ans As String
Dim olMsg As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim olAtt As Attachment
Dim strFilename As String

Dim argh As Double
Const strPath As String = "G:\korteles\ISSUING\Reps\"
Set olMsg = Application.CreateItem(olMailItem)



With olMsg
.Subject = "Failai"
.To = "vv.com"
strFilename = Dir$(strPath & "*.pdf")
While Len(strFilename) <> 0
.Attachments.Add strPath & strFilename, olByValue
strFilename = Dir$()
Wend
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
.Display 'required to edit body
oRng.Text = ""
If .Attachments.count < 1 Then
olMsg.Close olDiscard
Ans = MsgBox("Nėra jokių PDF failų " & strPath & ". Laiškas neišsiųstas. Ar suarchyvuoti kitus REPS failus?", vbYesNo + vbQuestion, "Nėra PDF failų")
Select Case Ans
Case vbYes
argh = Shell("G:\korteles\ISSUING\Reps\Arch\Reps sutvarkymas.bat", vbNormalFocus)
MsgBox "Reps failai suarchyvuoti!", , "Lengvai!"
Case vbNo
MsgBox "Reps failai nesuarchyvuoti", vbExclamation, "Nutraukta"
GoTo lbl_Exit
End Select
Else
.send
argh = Shell("G:\korteles\ISSUING\Reps\Arch\Reps sutvarkymas.bat", vbNormalFocus)
MsgBox "PDF išsiųsti Rimai, REPS suarchytuoti!", , "Lengvai!"
End If
End With


lbl_Exit:
Set olMsg = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub

End Sub

gmayor
06-03-2015, 06:36 AM
If you add the lines



If Dir$(strPath & "*.*") = "" Then
MsgBox "The folder is empty or missing."
GoTo lbl_Exit
End If

before you create the message, if the folder is empty (or missing) the msgbox will display and the macro will end.

stogdengys
06-04-2015, 12:26 AM
Thank You !!! My problem solved!