VBA错误运行时间13错误类型不匹配找不到它发生的位置

时间:2013-10-03 00:36:20

标签: excel-vba vba excel

我一直在寻找几个小时试图找到如何修复我的代码,但问题是我无法分辨错误的来源!请帮忙!

我一直收到“运行时错误13类型不匹配”

Sub Mail_Every_Worksheet()

    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If

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

    Set OutApp = CreateObject("Outlook.Application")

    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("D9").Value Like "?*@?*.?*" Then

            sh.Copy
            Set wb = ActiveWorkbook

            TempFileName = "Sheet " & sh.Name & " of " _
                         & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

            Set OutMail = OutApp.CreateItem(0)

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

                On Error Resume Next
                With OutMail
                    .to = sh.Range("D9").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "WEEKLY BOOKING REPORT " & sh.Range("K3").Value
                    .Body = "Hi " & sh.Range("D8").Value & vbNewLine & "Please find attached our updated weekly booking report." & vbNewLine & "If I can be of further assistance please do not hesitate to contact me."
                    .Attachments.Add wb.FullName
                    .Display   'or use .Send
                End With
                On Error GoTo 0

                .Close savechanges:=False
            End With

            Set OutMail = Nothing

            Kill TempFilePath & TempFileName & FileExtStr

        End If
    Next sh

    Set OutApp = Nothing

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

2 个答案:

答案 0 :(得分:2)

在您上一次Dim声明之后(或整个Dim声明之前),请输入以下内容:

On Error Goto ErrHandler

然后在你的程序的底部(紧接End Sub之前),输入如下内容:

ErrHandler:
    If Err.Number <> 0 Then
        Stop 'DO NOT LEAVE THAT IN PRODUCTION CODE!!!
        Resume 'pressing F8 when "Stop" is highlighted will take you to the error line.
    End If

请注意,这严格来说是一个“调试”错误处理程序 - 如果您在生产中有这样的代码,并且遇到错误,VBA IDE将会显示给您的用户进行调试。如果你将Resume留在那里,你就会有一个不错的无限循环。

此外,您的On Error Goto 0会使错误处理程序无效,因此请将其替换为On Error Goto ErrHandler

答案 1 :(得分:1)

我不确定它是否可以这么简单:我认为.xlsm是在excel版本12(2007)中引入的,但是您的代码要求Excel版本小于12(不会有xlsm文件类型) )。将代码更改为“大于11”会有帮助吗?

If Val(Application.Version) > 11 Then
    FileExtStr = ".xlsm": FileFormatNum = 52
End If