I am using Excel to compile existing PDF files and email them or print them depending on the recipients preferred method of contact.
Once the code (below) has run I would like the files to be deleted. I have tried to use the Kill function, but am finding that I get the error "Run-time error '70' - Permission denied".
I'm assuming this is because at least one of the files is still being used by Acrobat Reader when the kill function attempts to delete. I've used the kill function separately to the main code and it seems to work ok.
Is there a way to pause the code until the printing is completed?
Many thanks in advance......
Option Explicit
Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Public Sub PrintFile(ByVal strPathAndFilename As String)
Call apiShellExecute(Application.hwnd, "print", strPathAndFilename, vbNullString, vbNullString, 0)
End Sub
Sub SEND_BUDGETS()
Dim FILE_NAME As String
Dim OUT_APP As Outlook.Application
Dim OUT_MAIL As Outlook.MailItem
Dim A As Integer
Dim B As Integer
Dim C As String
Dim YEAR_END As Integer
Dim PROP_FOLDER As String
If Sheet2.Range("A1").Value <> "ref" Then
MsgBox ("Invalid data entered - Please try again")
Exit Sub
End If
Application.ScreenUpdating = False
Sheet1.Visible = True
YEAR_END = InputBox("Please enter service charge period end year")
PROP_FOLDER = Sheet2.Range("A2") & " - " & Sheet2.Range("B2")
If Dir("G:\accounts\Service Charge Team\Sent Budget Packs\P" & PROP_FOLDER, vbDirectory) = vbNullString Then
MkDir "G:\accounts\Service Charge Team\Sent Budget Packs\P" & PROP_FOLDER
MkDir "G:\accounts\Service Charge Team\Sent Budget Packs\P" & PROP_FOLDER & "\" & YEAR_END
Else
If Dir("G:\accounts\Service Charge Team\Sent Budget Packs\P" & PROP_FOLDER & "\" & YEAR_END, vbDirectory) <> vbNullString Then
MsgBox ("Folder for year end " & YEAR_END & " already exists - Please try again")
Sheet1.Visible = xlVeryHidden
Application.ScreenUpdating = True
Exit Sub
Else
MkDir "G:\accounts\Service Charge Team\Sent Budget Packs\P" & PROP_FOLDER & "\" & YEAR_END
End If
End If
'GET LIST OF FILES FROM "FILES TO SEND" FOLDER
Sheet1.Range("A2:A2000").ClearContents
FILE_NAME = Dir("G:\accounts\Service Charge Budget Emailer\Files To Send\" & "*.*")
Sheet1.Activate
Sheet1.Range("A2").Activate
Application.Calculation = xlManual
Do While Len(FILE_NAME) > 0
ActiveCell.Value = FILE_NAME
FILE_NAME = Dir
ActiveCell.Offset(1, 0).Select
Loop
Application.Calculation = xlAutomatic
ThisWorkbook.RefreshAll
'CHECK IF FILES HAVE BEEN FOUND
If Sheet1.Range("A1").Value = "FILE LIST - 0" Then
Sheet1.Visible = xlVeryHidden
Application.ScreenUpdating = True
Sheet2.Select
MsgBox ("Please add files to:-" & vbNewLine & vbNewLine & "G:\accounts\Service Charge Budget Emailer\Files To Send\")
Exit Sub
End If
'SEND EMAILS
Set OUT_APP = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set OUT_APP = CreateObject("Outlook.Application")
End If
On Error Resume Next
For A = 2 To Range("D2001").End(xlUp).Row
Set OUT_MAIL = OUT_APP.CreateItem(olMailItem)
If Sheet1.Range("N" & A).Value = "EMAIL" Then
With OUT_MAIL
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>Dear Proprietor,<p>" _
& "Please find attached service charge budget and any related paperwork in reference to the subject property.<p>" _
& "Kind regards,<p>"
.To = Cells(A, 15).Value
.Subject = Cells(A, 16).Value & " - Year Ending " & YEAR_END
.Attachments.Add Cells(A, 9).Value
.Attachments.Add Cells(A, 10).Value
.Attachments.Add Cells(A, 11).Value
.Attachments.Add Cells(A, 12).Value
.Attachments.Add Cells(A, 13).Value
.SaveAs "G:\accounts\Service Charge Team\Sent Budget Packs\P" & PROP_FOLDER & "\" & YEAR_END & "\" & Cells(A, 16) & " - Year Ending " & YEAR_END & ".msg", OlSaveAsType.olMSG
.Send
End With
ElseIf Sheet1.Range("N" & A).Value = "PRINT" Then
On Error GoTo 0
For B = 9 To 13
If Cells(A, B) <> "" Then
C = Cells(A, B).Value
PrintFile (C)
If Dir("G:\accounts\Service Charge Team\Sent Budget Packs\P" & PROP_FOLDER & "\" & YEAR_END & "\" & Cells(A, 16), vbDirectory) = vbNullString Then
MkDir "G:\accounts\Service Charge Team\Sent Budget Packs\P" & PROP_FOLDER & "\" & YEAR_END & "\" & Cells(A, 16)
End If
FileCopy C, "G:\accounts\Service Charge Team\Sent Budget Packs\P" & PROP_FOLDER & "\" & YEAR_END & "\" & Cells(A, 16) & "\" & Cells(A, B - 5)
End If
Next B
End If
Next A
Kill ("G:\accounts\Service Charge Budget Emailer\Files To Send\" & "*.*")
Sheet1.Visible = xlVeryHidden
Application.ScreenUpdating = True
MsgBox ("Complete")
