Solved: send sheet

[Djblois]

I am currently using code so a user can send just one sheet in email. Unfortunetely it is not working, it creates the workbook with just the sheet but it is not naming the workbook like it is supposed to and it is not attaching the workbook to the email either. I also have code in there so the user will send in the 2003 format, if they so desire. Here is the code:

Sub eMailActiveWorksheet()

sendemail:

On Error Resume Next

Dim objOutlook As Object, EmailItem As Object
Dim wbToEmail As Workbook
Dim filename As String, TempChar As String, SaveName As String
Dim Y As Long, Pos As Variant

Set objOutlook = CreateObject("Outlook.Application")
Set EmailItem = objOutlook.CreateItem(0)
'Create File with only ActiveSheet
filename = ActiveSheet.Name & " - " & ActiveWorkbook.Name
For Y = 1 To Len(filename)
TempChar = Mid(filename, Y, 1)
Select Case TempChar
Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":"
Case Else
SaveName = SaveName & TempChar
End Select
Next Y
'Create File with only ActiveSheet
ActiveSheet.Copy
Set wbToEmail = ActiveWorkbook
If frmEmailWork.cbSendInOldFormat Then
Pos = InStrRev(SaveName, ".")
If Pos > 0 Then
SaveName = Left$(SaveName, Pos - 1)
End If
wbToEmail.SaveAs "H:\" & Application.UserName & "\" _
& SaveName & ".xls", FileFormat:=xlNormal
Else
wbToEmail.SaveAs "H:\" & Application.UserName & "\" _
& SaveName & ".xlsx", FileFormat:=xlExcel12
End If

'wbToEmail.ChangeFileAccess xlReadOnly
With EmailItem
.Attachments.Add wbToEmail.FullName
.Display
End With
Kill wbToEmail.FullName
wbToEmail.Close False

Set objOutlook = Nothing
Set EmailItem = Nothing

End Sub

[Bob Phillips]

You are getting an error of some sort, but the On Error Resume Next at the start is maksing it. Comment it out and run it again. Probably that you don't have a diorectory in H with the UserName.

[Djblois]

Thank you - there were actually 3 errors. I got it now. sorry to bother. jk