如何将.htm附件另存为.txt文件？

Question

我创建了以下代码，该代码将所有选定的附件另存为PDF文件，根据收到的日期和主题行将其重命名，从电子邮件中删除图像附件，并添加版本。

当我尝试为.htm附件运行宏时，附件未保存在保存位置。

我想在代码中写一个部分，将.htm附件另存为.txt文件。

Public Sub saveattachmentsadddate()

    Dim itm As Outlook.MailItem
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim objAtt As Outlook.Attachment
    Dim fso As Object
    Dim oldname
    Dim file As String
    Dim DateFormat As String
    Dim sName As String
    Dim dtDate As Date
    Dim strFolderpath  As String

    strFolderpath = "P:\Orders\Repository\"
    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection
    Set fso = CreateObject("Scripting.FileSystemObject")

    On Error Resume Next
    If itm.Attachments.count > 0 Then

        For Each itm In Selection
            For Each objAtt In itm.Attachments
                If Not objAtt.filename Like "image*.*" Then
                    file = strFolderpath & objAtt.DisplayName
                    objAtt.SaveAsFile file

                    'Get the file name
                    Set oldname = fso.GetFile(file)
                    x = 1
                    Saved = False
                    sName = itm.Subject
                    ReplaceCharsForFileName sName, "_"
                    dtDate = itm.ReceivedTime
                    sName = Format(dtDate, "yyyy-mm-dd hh.mm.ss ", vbUseSystemDayOfWeek, _
                                   vbUseSystem) & "- " & sName & SaveAsFile & ".pdf"
                    oldname.name = sName
                    'See if file name  exists
                    If FileExist(strFolderpath & sName) = False Then
                        oldname.name = sName
                        GoTo NextAttach
                    End If

                    'Need a new filename
                    count = InStrRev(sName, ".")
                    FnName = Left(sName, count - 1)
                    FileExt = Right(sName, Len(sName) - count + 1)

                    Do While Saved = False
                        If FileExist(strFolderpath & FnName & " (" & x & ")" & FileExt) = False Then
                            oldname.name = FnName & " (" & x & ")" & FileExt
                            Saved = True
                        Else
                            x = x + 1
                        End If
                    Loop
NextAttach:
                    Set objAtt = Nothing
                End If
            Next
        Next
    End If
    Set fso = Nothing
    MsgBox "Complete!", vbExclamation
End Sub

Function FileExist(FilePath As String) As Boolean

    Dim TestStr As String
    Debug.Print FilePath

    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0

    'Determine if File exists
    If TestStr = "" Then
        FileExist = False
    Else
        FileExist = True
    End If

End Function