Delete Files and Folder - Not Working

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
5,046
Office Version
  1. 2019
  2. 2007
Platform
  1. Windows
.
Posted here as well : https://chandoo.org/forum/threads/folder-files-delete.39877/

I have a VBA email macro that first produce a PDF of a worksheet, creates a folder on the desktop named PDFs and saves the pdf of the worksheet there.

After sending the email, with the pdf attachment, the code successfully deletes the pdf file but refuses to delete the folder until the workbook is closed. Very inconvenient.

Here is the code I am using. What changes would you recommend to get the folder to delete without having to close the workbook first ?

Thank you.


Code:
[COLOR=#141414][FONT=Verdana]Option Explicit[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]Sub pdf()[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim wsA As Worksheet, wbA As Workbook, strTime As String[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim strName As String, strPath As String[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim strFile As String[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim strPathFile As String[/FONT][/COLOR]


[COLOR=#141414][FONT=Verdana]'On Error GoTo errHandler[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]Set wbA = ActiveWorkbook[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Set wsA = ActiveSheet[/FONT][/COLOR]


[COLOR=#141414][FONT=Verdana]'replace spaces and periods in sheet name[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]strName = Replace(wsA.Name, " ", "")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]strName = Replace(strName, ".", "_")[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]'create default name for savng file[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]'strPath = "G:\Finance\Corporate Accounting\SHIRLEY\A. Financial Planning Fee Payment Processing\"[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]strPath = "C:\Users\My\Desktop\PDFs\"[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]strFile = strName '"_" & strTime & "_" & Sheets("MDM Invoice").Range("B2").Value[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]strPathFile = strPath & strFile[/FONT][/COLOR]


[COLOR=#141414][FONT=Verdana]Dim myFolder$[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]myFolder = Environ("UserProfile") & "\Desktop\PDFs"[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]If Dir(myFolder, vbDirectory) = "" Then[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]MkDir myFolder[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End If[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]'export to PDF if a folder was selected[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]wsA.ExportAsFixedFormat 0, strPathFile[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]If Len(Dir$(myFolder)) > 0 Then[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]SetAttr myFolder, vbNormal[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End If[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]'confirmation message with file info[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]MsgBox "PDF file has been created: " _[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]& vbCrLf _[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]& strPathFile[/FONT][/COLOR]


[COLOR=#141414][FONT=Verdana]exitHandler:[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Exit Sub[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]errHandler:[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]MsgBox "Could not create PDF file"[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Resume exitHandler[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End Sub[/FONT][/COLOR]


[COLOR=#141414][FONT=Verdana]Sub Mail_workbook_Outlook()[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]Dim c As Range[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim OutApp As Object[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim OutMail As Object[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim strPath As String[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim FileName As String[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]Set OutApp = CreateObject("Outlook.Application")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Set OutMail = OutApp.CreateItem(0)[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]strPath = Environ("UserProfile") & "\Desktop\PDFs\"[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]FileName = Dir(strPath & "*.*")[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]'On Error Resume Next[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Set OutApp = CreateObject("Outlook.Application")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Set OutMail = OutApp.CreateItem(0)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]With OutMail[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].To = c.Value[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].CC = ""[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].BCC = ""[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Subject = c.Offset(0, 1).Value[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Body = "The parts have been placed on today's load sheet and will be processed by EOB today. The parts have also been transferred to the repository file."[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]FileName = Dir(strPath & "*.*")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Attachments.Add strPath & FileName[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]'.Send '<-- .Send will auto send email without review[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Display '<-- .Display will show the email first for review[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]'On Error GoTo 0[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Next c[/FONT][/COLOR]


[COLOR=#141414][FONT=Verdana]Set OutMail = Nothing[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Set OutApp = Nothing[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]byby[/FONT][/COLOR]


[COLOR=#141414][FONT=Verdana]End Sub[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]Sub byby()[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim folder As Object[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim path As String[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]path = Environ("UserProfile") & "\Desktop\PDFs"[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Set folder = CreateObject("scripting.filesystemobject")[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]folder.deletefolder path, True[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]End Sub[/FONT][/COLOR][COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]

 
Last edited:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
An alternative method, first deleting all files in the folder

Code:
Sub DeleteFolderPath()
    Dim path As String
    path = Environ("UserProfile") & "\Desktop\PDFs"
    On Error Resume Next
        Kill path & "\" & "*.*"
        RmDir path
    On Error GoTo 0
End Sub
 
Last edited:
Upvote 0
.
Thank you for your answer Yongle. Unfortunately, no luck.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,322
Members
452,635
Latest member
laura12345

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