Ограничить число раз, когда расширение файла появляется в прикреплении макроса электронной почты

Question

У меня есть код ниже, который добавляет расширение файла к имени вложения. Это нормально, если файл отправляется только один раз - как это было в предыдущем приложении этого кода. Однако теперь мне нужно, чтобы файл обновлялся и затем снова отправлялся, НО, когда я запускаю приведенный ниже код, я получаю файл с расширением файла, добавленным к имени вложения несколько раз. (file.xlsm.xlsm.xlsm и т. д.)

Как я могу изменить приведенный ниже код, чтобы остановить это - полностью застрял и сумел сломать все это дважды сейчас!

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Set wb1 = ThisWorkbook


If Val(Application.Version) >= 12 Then
    If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
        MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
               "be no VBA code in the file you send. Save the" & vbNewLine & _
               "file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
        Exit Sub
    End If
End If

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

TempFileName = wb1.Name
FileExtStr = "." & LCase(Right(wb1.Name, _
                               Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = wb1.Sheets("Internal Use Only").Range("F7").Value
    .CC = wb1.Sheets("Supplier Details").Range("Q25").Value
    .BCC = ""
    .Subject = "Audit Request processed"
    .Body = "some text"
    .Attachments.Add wb2.FullName
    .Display
End With
On Error GoTo 0

wb2.Close SaveChanges:=False

' Delete the file.
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Answer 1

Вы получаете расширение файла из имени файла. Затем вы добавляете расширение обратно к имени файла, которое уже включает его (потому что это то, откуда вы его взяли).

Просто удалите расширение из имени файла после того, как вы получите расширение.

Заменить:

TempFileName = wb1.Name
FileExtStr = "." & LCase(Right(wb1.Name, _
                               Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

С:

FileExtStr = "." & LCase(Right(wb1.Name, _
                               Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

TempFileName = Left(wb1.Name, Len(wb1.Name) - Len(FileExtStr))