Hi
I have the following Code to send an email attachment of a specific sheet however is seems that it is not attaching as an excel document and in the Draft email it shows a doc without a .xls or whatever.
Code as follows
Sub EmailWithOutlook1()
Dim oApp As Object
Dim oMail As Object
Dim wb As Workbook
Dim FileName As String
Dim wSht As Worksheet
Dim shtName As String
Application.ScreenUpdating = False
Sheets("Quote Email").Select
Columns("P:S").Select
Selection.EntireColumn.Hidden = True
Sheets("Quote Email").Copy
Set wb = ActiveWorkbook
FileName = wb.Worksheets(1).Name
FPath = "C:\Users\xxxxx\xxx Corporation\xx xxx - Documents\xxx PM\xxx Billing\Test\"
FileName = Sheets("Quote Email").Range("A3").Text
On Error Resume Next
Kill FPath & FileName
On Error GoTo 0
wb.SaveAs FileName:=FPath & FileName
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a recipient
.To = "someone@xxx.co.uk"
.CC = "someone@somewher.com"
'Uncomment the line below to hard code a subject
.Subject = Sheets("Quote Email").Range("A3").Text
'Uncomment the lines below to hard code a body
.Body = "All" & vbCrLf & vbCrLf & _
"PSA"
.Attachments.Add wb.FullName
.Display
End With
wb.ChangeFileAccess Mode:=xlReadOnly
Kill wb.FullName
wb.Close savechanges:=False
Selection.EntireColumn.Hidden = False
'Restore screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
Sheets("Home").Select
End Sub
Hope someone can help
I have the following Code to send an email attachment of a specific sheet however is seems that it is not attaching as an excel document and in the Draft email it shows a doc without a .xls or whatever.
Code as follows
Sub EmailWithOutlook1()
Dim oApp As Object
Dim oMail As Object
Dim wb As Workbook
Dim FileName As String
Dim wSht As Worksheet
Dim shtName As String
Application.ScreenUpdating = False
Sheets("Quote Email").Select
Columns("P:S").Select
Selection.EntireColumn.Hidden = True
Sheets("Quote Email").Copy
Set wb = ActiveWorkbook
FileName = wb.Worksheets(1).Name
FPath = "C:\Users\xxxxx\xxx Corporation\xx xxx - Documents\xxx PM\xxx Billing\Test\"
FileName = Sheets("Quote Email").Range("A3").Text
On Error Resume Next
Kill FPath & FileName
On Error GoTo 0
wb.SaveAs FileName:=FPath & FileName
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a recipient
.To = "someone@xxx.co.uk"
.CC = "someone@somewher.com"
'Uncomment the line below to hard code a subject
.Subject = Sheets("Quote Email").Range("A3").Text
'Uncomment the lines below to hard code a body
.Body = "All" & vbCrLf & vbCrLf & _
"PSA"
.Attachments.Add wb.FullName
.Display
End With
wb.ChangeFileAccess Mode:=xlReadOnly
Kill wb.FullName
wb.Close savechanges:=False
Selection.EntireColumn.Hidden = False
'Restore screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
Sheets("Home").Select
End Sub
Hope someone can help