直到最近，我一直在使用 Excel 2013，但我現在已經升級到 Office 365。我所指的 Excel 檔案是在 2013 年構建的。我有一個宏可以保存“報告”選項卡并將其附加到電子郵件中但是附件在嘗試打開時回傳以下錯誤；
'Excel 無法打開檔案 'Document1.xlsm'，因為檔案格式或檔案擴展名無效。驗證檔案未損壞并且檔案擴展名與檔案格式匹配'
我已經檢查過原始 Excel 檔案和附件是否是相同的檔案格式。以下是 VBA - 任何有關嘗試的建議將不勝感激:)
Sub EmailSelectedSheets()
Dim SourceWB As Workbook
Dim DestinWB As Workbook
Dim OutlookApp As Object
Dim OutlookMessage As Object
Dim TempFileName As Variant
Dim ExternalLinks As Variant
Dim TempFilePath As String
Dim FileExtStr As String
Dim DefaultName As String
Dim UserAnswer As Long
Dim x As Long
Dim Rng As Range, mystr As String
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Copy only selected sheets into new workbook
Set SourceWB = ActiveWorkbook
Sheet5.Select
SourceWB.Windows(1).SelectedSheets.Copy
Set DestinWB = ActiveWorkbook
'Determine Temporary File Path
TempFilePath = Environ$("temp") & "\"
'Determine Default File Name for InputBox
TempFileName = "Test"
If SourceWB.Saved Then
DefaultName = Left(SourceWB.Name, InStrRev(SourceWB.Name, ".") - 1)
Else
DefaultName = SourceWB.Name
End If
'Determine File Extension
If SourceWB.Saved = True Then
FileExtStr = "." & LCase(Right(SourceWB.Name, Len(SourceWB.Name) - InStrRev(SourceWB.Name, ".", , 1)))
Else
FileExtStr = ".xlsm"
End If
'Break External Links
ExternalLinks = DestinWB.LinkSources(Type:=xlLinkTypeExcelLinks)
'Loop Through each External Link in ActiveWorkbook and Break it
On Error Resume Next
For x = 1 To UBound(ExternalLinks)
DestinWB.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
On Error GoTo 0
'Save Temporary Workbook
DestinWB.SaveCopyAs TempFilePath & TempFileName & FileExtStr
'Create Instance of Outlook
On Error Resume Next
Set OutlookApp = GetObject(Class:="Outlook.Application") 'Handles if Outlook is already open
Err.Clear
If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(Class:="Outlook.Application") 'If not, open Outlook
If Err.Number = 429 Then
MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
GoTo ExitSub
End If
On Error GoTo 0
'Create a new email message
Set OutlookMessage = OutlookApp.CreateItem(0)
'Create Outlook email with attachment
On Error Resume Next
Set Rng = Worksheets("Sheet4").Range("B7:B23")
Set Rng = Worksheets("Sheet4").Range("B7:B23").Merge(True)
mystr = Join(Application.Transpose(Rng.Value), ";")
With OutlookMessage
.SentOnBehalfOfName "[email protected]"
.To = Sheet4.Range("B6").Text
.CC = ""
.BCC = ""
.Subject = TempFileName
.Body = "Please find attached the latest report." & vbNewLine & vbNewLine & "Kind regards"
.Attachments.Add TempFilePath & TempFileName & FileExtStr
.Display
End With
On Error GoTo 0
'Close & Delete the temporary file
DestinWB.Close SaveChanges:=False
Kill TempFilePath & TempFileName & FileExtStr
'Clear Memory
Set OutlookMessage = Nothing
Set OutlookApp = Nothing
'Optimize Code
ExitSub:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
uj5u.com熱心網友回復：
原始檔案和附件的格式不同（問題與每封郵件發送檔案無關）。
原始檔案是一個包含宏的檔案，檔案型別是（最有可能的）xlOpenXMLWorkbookMacroEnabled(52)，擴展名是xlsm. 您將其中一張作業表 (sheet5) 復制到新作業簿中。當您使用該copy方法時，Excel 所做的是以默認檔案格式創建作業簿（您可以在“保存”下的 Excel 選項中進行設定）。在大多數情況下，這是格式xlOpenXMLWorkbook(51)，即無宏作業簿，擴展名為xlsx.
您現在要做的是使用該SaveCopyAs方法保存此作業簿。您提供帶有擴展名的檔案名xlsm，但這不會更改檔案格式。因此，您仍然擁有一個無宏作業簿的檔案，但帶有啟用宏的作業簿的擴展名。因此擴展名和檔案格式不適合，因此您將收到您（或收到郵件的任何人）看到的錯誤訊息。
您可以通過洗掉kill命令輕松證明這一點，轉到您的臨時檔案夾并嘗試打開該檔案 - 您將收到相同的錯誤訊息。現在將檔案重命名為.xlsxvoilà，您可以打開該檔案。
您的代碼存在一些問題。我想您應該重構代碼并將其拆分為至少 2 個例程：一個將作業表保存為作業簿，另一個用于發送郵件。有了它，您可以更輕松地測驗您的功能，因為保存和發送是兩個獨立的任務。
select當您想復制作業表時不需要它（您幾乎不需要選擇或激活任何東西），并且您不應該通過Window- 屬性訪問作業表。只需使用ActiveWorkbook.sheets(5).Copy.
復制作業表后，您創建了一個新作業簿 - 您只需要保存它。不要SaveCopyAs用于那個，使用SaveAs. 在那里，您可以指定檔案型別，Excel 會很樂意以您想要的格式保存檔案（并在必要時進行轉換）。
如果您堅持，您可以將副本保存為啟用宏，但是當您通過郵件發送檔案時，無宏通常是更好的選擇。請注意檔案型別和擴展名適合。或者完全省略擴展名，在這種情況下，Excel 會自動為您添加它。
我重構了你的代碼，看看
Sub EmailSelectedSheets()
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim tmpFileName As String
tmpFileName = SaveSheetAsTempFile(ThisWorkbook.Sheets(1)) ' Or whatever you want to save...
SendMail tmpFileName
Kill tmpFileName
ExitSub:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Function SaveSheetAsTempFile(ws As Worksheet) As String
Dim DestinWB As Workbook
ws.Copy
Set DestinWB = ActiveWorkbook
ExternalLinks = DestinWB.LinkSources(Type:=xlLinkTypeExcelLinks)
'Loop Through each External Link in ActiveWorkbook and Break it
On Error Resume Next
Dim x As Long
For x = 1 To UBound(ExternalLinks)
DestinWB.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
On Error GoTo 0
Dim tmpFileName As String
tmpFileName = Left(ws.Parent.Name, InStrRev(ws.Parent.Name, ".") - 1)
tmpFileName = Environ$("temp") & "\" & tmpFileName & ".xlsx"
DestinWB.SaveAs tmpFileName, xlOpenXMLWorkbook
SaveSheetAsTempFile = tmpFileName
End Function
Sub SendMail(attachmentName As String)
' do your email sending stuff here...
.Attachments.Add attachmentName
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/319091.html
下一篇：Javascript函式被截斷？