Сохранить выбранный адрес электронной почты + вложения в формате PDF в папке

Question

Я устанавливаю макрос, который сохраняет электронную почту и ее вложение в папке, и я хочу уничтожить temp .mht, чтобы перейти к следующему выбору, потому что я получаю ошибку

Файл используется другой программой

PS: код иногда работает, а иногда нет, и я хочу найти решение для файла tmp, созданного после того, как электронная почта была открыта для сохранения

Sub SaveMessageAsPDF()

Dim Selection As Selection
Dim obj As Object
Dim Item As MailItem

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Set Selection = Application.ActiveExplorer.Selection

For Each obj In Selection

Set Item = obj

Dim FSO As Object, TmpFolder As Object
Dim sName As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set tmpFileName = FSO.GetSpecialFolder(2)

sName = Item.Subject
ReplaceCharsForFileName sName, "-"
tmpFileName = tmpFileName & "\" & sName & ".mht"

Item.SaveAs tmpFileName, olMHTML


Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=True)

Dim WshShell As Object
Dim SpecialPath As String
Dim strToSaveAs As String
Set WshShell = CreateObject("WScript.Shell")
MyDocs = WshShell.SpecialFolders(16)

strToSaveAs = MyDocs & "\" & sName & ".pdf"

' check for duplicate filenames
' if matched, add the current time to the file name
If FSO.FileExists(strToSaveAs) Then
sName = sName & Format(Now, "hhmmss")
strToSaveAs = MyDocs & "\" & sName & ".pdf"
End If

wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
strToSaveAs, ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=0, To:=0, Item:= _
wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

Next obj
wrdDoc.Close
wrdApp.Quit
Set wrdDoc = Nothing
Set wrdApp = Nothing
Set WshShell = Nothing
Set obj = Nothing
Set Selection = Nothing
Set Item = Nothing

End Sub

' This function removes invalid and other characters from file names
Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
sName = Replace(sName, "&", sChr)
sName = Replace(sName, "%", sChr)
sName = Replace(sName, "*", sChr)
sName = Replace(sName, " ", sChr)
sName = Replace(sName, "{", sChr)
sName = Replace(sName, "[", sChr)
sName = Replace(sName, "]", sChr)     
sName = Replace(sName, "}", sChr)
sName = Replace(sName, "!", sChr)
End Sub

Я пытался сделать что-то, что убивает файлы, когда они сохраняются в pdf, но проблема, когда я выполняю вызов функции из основного кода, возвращает

Разрешение не принято

но когда я пытаюсь выполнить функцию в одиночку, она отлично работает

Sub OpenClose()
strFileName = Dir("C:\Users\benfarhat\Desktop\aa\*")
Do While strFileName <> ""
If LCase$(strFileName) Like "*.mht" Then  'or .txt or .csv or whatever
 Kill "C:\Users\benfarhat\Desktop\aa\" & strFileName
  End If
  strFileName = Dir
 Loop

End Sub

, а также

Sub Kill_Word()
Dim sKillWord As String
sKillWord = "TASKKILL /F /IM Winword.exe"
Shell sKillWord, vbHide
End Sub

есть идеи о том, как этого добиться?

С наилучшими пожеланиями,