Я использую Excel, чтобы скомпилировать существующие файлы PDF и отправить их по электронной почте или распечатать в зависимости от предпочтительного способа связи получателей.
После запуска кода (ниже) я бы хотел, чтобы файлы были удалены.Я пытался использовать функцию Kill, но обнаружил, что я получаю сообщение об ошибке «Ошибка времени выполнения« 70 »- разрешение запрещено».
Я предполагаю, что это потому, что хотя бы один из файловвсе еще используется Acrobat Reader, когда функция kill пытается удалить.Я использовал функцию уничтожения отдельно от основного кода, и она, кажется, работает нормально.
Есть ли способ приостановить код до завершения печати?
Большое спасибо заранее......
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")