VBA export PDF, attach to email and send email

Sweedler

Board Regular
Joined
Nov 13, 2020
Messages
132
Office Version
  1. 365
Platform
  1. Windows
Hello

I am using the following code to try to achieve this, but I am running into error issues. I have made the error area in bold text. I am hoping that someone can help me.

Rich (BB code):
Sub Indi_SV_generator()

Dim OutApp As Object
Dim Outmail As Object

Set OutApp = CreateObject("outlook.application")
Set Outmail = OutApp.CreateItem(0)

Dim bolaget As String
Dim plats As String
Dim namn As String
Dim year As Integer
Dim month As Integer
Dim day As Integer
Dim i As Integer
Dim a As Integer


Dim filename As Range
Dim savelocation As String


bolaget = Sheet6.Range("K1")
plats = Sheet6.Range("K2")
year = Sheet6.Range("K4")
month = Sheet6.Range("K5")
day = Sheet6.Range("K6")
a = Sheet6.Range("K7")

For i = a To 2 Step -1

namn = Sheet6.Cells(i, 1)
Sheet6.Range("K8") = Sheet6.Cells(i, 1)

    Set filename = Sheet4.Range("A1")
    savelocation = "C:\Users\marcu\Desktop\EXCELLENT HELP - PC\Customers\Moll Wenden\Test folder\ " & "Individuellt - " & namn & " - " & year & "-" & month & "-" & day
   
Sheets("INDI SV").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    filename:=savelocation

With Outmail

    .to = Sheet6.Cells(i, 2)
    .Subject = "RÄTTNING"
    .Body = "vänligen se bifogad fil"
    .attachments.Add (savelocation & ".pdf")

    .display
   
End With

   
Next i

End Sub


The PDF export works flawlessly, but I the export to email is not working.

Hoping that you can help me,
Cheers
 
Last edited by a moderator:

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Compare this edited code to yours and see the differences. This edited version works here.

VBA Code:
Sub Indi_SV_generator()

Dim OutApp As Object
Dim Outmail As Object

Set OutApp = CreateObject("outlook.application")
Set Outmail = OutApp.CreateItem(0)

Dim bolaget As String
Dim plats As String
Dim namn As String
Dim year As Integer
Dim month As Integer
Dim day As Integer
Dim i As Integer
Dim a As Integer


Dim filename As Range
Dim savelocation As String


bolaget = Sheet1.Range("K1")
plats = Sheet1.Range("K2")
year = Sheet1.Range("K4")
month = Sheet1.Range("K5")
day = Sheet1.Range("K6")
a = Sheet1.Range("K7")

On Error Resume Next


For i = a To 2 Step -1

namn = Sheet1.Cells(i, 1)
Sheet1.Range("K8") = Sheet1.Cells(i, 1)

Set filename = Sheet2.Range("A1")
savelocation = "C:\Users\logit\OneDrive\Desktop\ " & "Individuellt - " & namn & " - " & year & "-" & month & "-" & day & ".pdf"

Sheets("Sheet2").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
filename:=savelocation

With Outmail

.to = Sheet1.Cells(i, 2).Value
.Subject = "RÄTTNING"
.Body = "vänligen se bifogad fil"
.attachments.Add (savelocation)

.display

End With


Next i

End Sub
 
Upvote 0
Hi all,
the line of code
VBA Code:
Set Outmail = OutApp.CreateItem(0)
should be inside the loop

Code:
For i = a To 2 Step -1
Set Outmail = OutApp.CreateItem(0)
 
Upvote 0
@Sweedler
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time. 😊
 
Upvote 0
I have taken both @Sequoyah and @Logit advice and now use the following code. But I still get an error on the same line:

activex component can't create object 429

Sub Indi_SV_generator()

Dim OutApp As Object
Dim Outmail As Object

Set OutApp = CreateObject("outlook.application")

Dim bolaget As String
Dim plats As String
Dim namn As String
Dim year As Integer
Dim month As Integer
Dim day As Integer
Dim i As Integer
Dim a As Integer

Dim filename As Range
Dim savelocation As String

bolaget = Sheet1.Range("K1")
plats = Sheet1.Range("K2")
year = Sheet1.Range("K4")
month = Sheet1.Range("K5")
day = Sheet1.Range("K6")
a = Sheet1.Range("K7")

On Error Resume Next

For i = a To 2 Step -1
Set Outmail = OutApp.CreateItem(0)

namn = Sheet1.Cells(i, 1)
Sheet1.Range("K8") = Sheet1.Cells(i, 1)

Set filename = Sheet2.Range("A1")
savelocation = "C:\Users\logit\OneDrive\Desktop\ " & "Individuellt - " & namn & " - " & year & "-" & month & "-" & day & ".pdf"

Sheets("Sheet2").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
filename:=savelocation

'Set OutApp = CreateObject("outlook.application")


With Outmail

.to = Sheet1.Cells(i, 2).Value
.Subject = "RÄTTNING"
.Body = "vänligen se bifogad fil"
.attachments.Add (savelocation)

.display

End With

Next i

End Sub
 
Upvote 0
I have taken both @Sequoyah and @Logit advice
.. but not mine. :(
If you want to continue to get free help from the forum I suggest that you make it as easy as possible for people to give that help. That is what my request was aimed at.
 
Upvote 0
Hello @Peter_SSs

I'm sorry that I did not understand your first comment to me. Is this correct now?


VBA Code:
Sub Indi_SV_generator()

Dim OutApp As Object
Dim Outmail As Object

[B]Set OutApp = CreateObject("outlook.application")[/B]

Dim bolaget As String
Dim plats As String
Dim namn As String
Dim year As Integer
Dim month As Integer
Dim day As Integer
Dim i As Integer
Dim a As Integer

Dim filename As Range
Dim savelocation As String

bolaget = Sheet1.Range("K1")
plats = Sheet1.Range("K2")
year = Sheet1.Range("K4")
month = Sheet1.Range("K5")
day = Sheet1.Range("K6")
a = Sheet1.Range("K7")

On Error Resume Next

For i = a To 2 Step -1
Set Outmail = OutApp.CreateItem(0)

namn = Sheet1.Cells(i, 1)
Sheet1.Range("K8") = Sheet1.Cells(i, 1)

Set filename = Sheet2.Range("A1")
savelocation = "C:\Users\logit\OneDrive\Desktop\ " & "Individuellt - " & namn & " - " & year & "-" & month & "-" & day & ".pdf"

Sheets("Sheet2").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
filename:=savelocation

'Set OutApp = CreateObject("outlook.application")


With Outmail

.to = Sheet1.Cells(i, 2).Value
.Subject = "RÄTTNING"
.Body = "vänligen se bifogad fil"
.attachments.Add (savelocation)

.display

End With

Next i

End Sub
 
Upvote 0
The following works here. You will need to change the SAVE LOCATION to match your computer. Presently the path is set for my computer here.

VBA Code:
Option Explicit

Sub Indi_SV_generator()

Dim OutApp As Object
Dim Outmail As Object

Set OutApp = CreateObject("outlook.application")
Set Outmail = OutApp.CreateItem(0)

Dim bolaget As String
Dim plats As String
Dim namn As String
Dim year As Integer
Dim month As Integer
Dim day As Integer
Dim i As Integer
Dim a As Integer

Dim filename As Range
Dim savelocation As String

    bolaget = Sheet1.Range("K1")
    plats = Sheet1.Range("K2")
    year = Sheet1.Range("K4")
    month = Sheet1.Range("K5")
    day = Sheet1.Range("K6")
    a = Sheet1.Range("K7")
    
    On Error Resume Next
    
        For i = a To 2 Step -1
        
        
        namn = Sheet1.Cells(i, 1)
        Sheet1.Range("K8") = Sheet1.Cells(i, 1)
        Set filename = Sheet2.Range("A1")
        savelocation = "C:\Users\logit\OneDrive\Desktop\ " & "Individuellt - " & namn & " - " & year & "-" & month & "-" & day & ".pdf"
        
        Sheets("Sheet2").Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        filename:=savelocation
        
        
            With Outmail
            
                .To = Sheet1.Cells(i, 2).Value
                .Subject = "RÄTTNING"
                .Body = "vänligen se bifogad fil"
                .attachments.Add (savelocation)
                
                .display
            
            End With
        
        Next i

End Sub
 
Upvote 0
Hello

This seems to be one step in the right direction as the Macro is running now, and it does generate the PDF files. What it does not do is produce and send emails. So there must be something still missing.

I have been reading around trying to figure this out elsewhere as well, and one thing that keeps getting mentioned is that "NEW" Outlook is not compatible to be run from a MACRO. Have you heard anything like this? I am unable to find outlook under tools and references in the Developer app.

Please help
 
Upvote 0

Attachments

  • email.jpg
    email.jpg
    52.8 KB · Views: 3
Upvote 0

Forum statistics

Threads
1,224,809
Messages
6,181,076
Members
453,020
Latest member
mattg2448

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top