VBA code, file overwriting

mateo93

New Member
Joined
Apr 30, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hello,
I have problem with overwriting file. When I create first pdf, data in outlook cant upload. When i trying do this second time and pfd file exist in folder, data show in outlok.


Sub SaveAsPDFandSend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xPath As String

Set xSht = Sheet12

xPath = "C:\Users\361mwrzos\OneDrive - Sonova\Desktop\worksheet to pdf" 'here "workshet to pdf" is the destination folder to save the pdf files
xFolder = xPath & "\" & Sheet12.Range("O1") & ".pdf"
If Len(Dir(xFolder)) > 0 Then
xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder
Else
MsgBox "if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard

'Create Outlook email
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.From = Sheet20.Range("C2")
.To = Sheet20.Range("D2") 'poprawic na c15 zeby podalo adres email w outlook
.CC = ""
.Subject = "Invoice " & Sheet12.Range("O1")
.Body = "Dear Sir od Madame" & vbCrLf & _
"In the attachment you will find cross charge invoice " & Sheet12.Range("O1") & "." & vbCrLf & _
"Let us know if any issues." & vbCrLf & _
"Best Regards,"
.Attachments.Add xFolder
If DisplayEmail = False Then
'.Send
End If
End With
Else
MsgBox "The active worksheet cannot be blank"
Exit Sub
End If
End Sub
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,301
.
I had to change the path here in order to properly test the code. You'll need to edit for your purposes there. Hopefully this code is sufficiently
annotated showing the changes made.

VBA Code:
Option Explicit

Sub SaveAsPDFandSend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xPath As String


Set xSht = Sheet1

xPath = "C:\Users\jimga\Desktop" 'here "workshet to pdf" is the destination folder to save the pdf files
xFolder = xPath & "\" & Sheet1.Range("A1").Value & ".pdf"
    
    If Len(Dir(xFolder)) > 0 Then
        xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
        vbYesNo + vbQuestion, "File Exists")
        
        On Error Resume Next
            If xYesorNo = vbYes Then
                Kill xFolder
            Else
                MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
                Exit Sub
            End If
            
        If Err.Number <> 0 Then
            MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
            & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
            Exit Sub
        End If
    End If

Set xUsedRng = xSht.UsedRange

    If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
        'Save as PDF file
        xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
        
        'Create Outlook email
        Set xOutlookObj = CreateObject("Outlook.Application")
        Set xEmailObj = xOutlookObj.CreateItem(0)
        
        With xEmailObj
            '.Display
            '.From = Sheets("Sheet1").Range("C1").Value
            .SentOnBehalfOfName = Sheets("Sheet1").Range("C1").Value
            .To = Sheet1.Range("D1").Value 'poprawic na c15 zeby podalo adres email w outlook
            .CC = ""
            .Subject = "Invoice " & Sheet1.Range("E1").Value
            .Body = "Dear Sir od Madame" & vbCrLf & _
            "In the attachment you will find cross charge invoice " & Sheet1.Range("E1") & "." & vbCrLf & _
            "Let us know if any issues." & vbCrLf & _
            "Best Regards,"
            .Attachments.Add xFolder
        
            'If DisplayEmail = False Then
                '.Send
            'End If
            .Display
            
        End With
    Else
        MsgBox "The active worksheet cannot be blank"
        Exit Sub
    End If
    
End Sub
 

mateo93

New Member
Joined
Apr 30, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
hello, thank You but still first time when I create new pdf i cant see data in outlook. WHen file is created and i run macro again, data is visible in Outlook.
 

mateo93

New Member
Joined
Apr 30, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Sorry, but its OK, Thank You very much! :)
 

rhombus4

Well-known Member
Joined
May 26, 2010
Messages
563
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Is it possible to resize the Sheet to fit on PDF or maybe turn PDF into landscape before it saves it
 

Forum statistics

Threads
1,148,396
Messages
5,746,452
Members
424,020
Latest member
LongDoo

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
Top