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

关于如何实现这一点的任何想法？

最好的问候，

将选定的电子邮件+附件另存为pdf文件

0 个答案: