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