Reputation: 13
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
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
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