Chantel
Chantel

Reputation: 13

VBA Error Run time 13 error Type Mismatch can't find where it's happening

I have been searching for hours trying to find how to fix my code but the problem is that I can't tell where the error is coming from! Please help!

I keep getting "run time error 13 Type mismatch"

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

Upvotes: 1

Views: 3722

Answers (2)

Mathieu Guindon
Mathieu Guindon

Reputation: 71187

Right after your last Dim statement (or before the whole Dim block), put something like this:

On Error Goto ErrHandler

Then at the bottom of your procedure (immediately before End Sub), put something like this:

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

Note that this is strictly a "debugging" error handler - should you have code like this in production, and run into an error, the VBA IDE would be brought up and shown to your user to debug. And if you leave Resume there, you'll have a nice infinite loop.

Also your On Error Goto 0 will void the error handler, so replace it with On Error Goto ErrHandler.

Upvotes: 2

Instant Breakfast
Instant Breakfast

Reputation: 1445

I'm not sure if it could be this simple: I think .xlsm was introduced with excel version 12 (2007) but your code is asking for Excel version to be less than 12 (which would not have an xlsm file type). Does it help to change the code to "greater than 11"?

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

Upvotes: 1

Related Questions