限制文件扩展名出现在电子邮件宏附件中的次数

时间:2019-01-03 14:46:55

标签: excel vba

我在下面有一些代码,它将文件扩展名添加到附件的名称中。只要该文件仅发送一次就可以了(这与该代码先前的应用程序一样)。但是,现在我可能需要更新文件,然后重新发送,但是当我运行下面的代码时,我最终得到一个文件,其文件扩展名多次添加到附件名称中。 (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

1 个答案:

答案 0 :(得分:0)

您正在从文件名获取文件扩展名。然后,您将扩展名附加回文件名,该文件名已经包含了该文件名(因为首先是从那里获取文件名的。)

获取扩展名后,只需从文件名中删除该扩展名即可。

替换:

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))