bombergirl61
New Member
- Joined
- Nov 19, 2014
- Messages
- 9
I am using the below VBA email code and works great, only when it emails the worksheet to recipient it send the work sheet with all the formulas and when recipient opens the speadsheet some cells have not populated correctly.
this work book has 10 worksheets that all go to an individual recipient
Question - where in the is code do i add the pastespecial values. I have tried after the SH.Copy to no avail. Our do I need to change to destWB somewhere
Sub Z_Mail_SHEET_BUY_all_copy()
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
Dim DueDate As String
Dim Body As String
Body = Format(ThisWorkbook.Sheets("National").Range("ad1").Value, "VB")
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
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("A1").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("A1").Value
.CC = ""
.BCC = ""
.Subject = "SS SHEET and PLATE REQUIREMENTS"
.Body = Format(ThisWorkbook.Sheets("National").Range("Ad1").Value, "VB")
.Attachments.Add wb.FullName
.Display 'disable display and enable send to send automatically
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
this work book has 10 worksheets that all go to an individual recipient
Question - where in the is code do i add the pastespecial values. I have tried after the SH.Copy to no avail. Our do I need to change to destWB somewhere
Sub Z_Mail_SHEET_BUY_all_copy()
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
Dim DueDate As String
Dim Body As String
Body = Format(ThisWorkbook.Sheets("National").Range("ad1").Value, "VB")
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
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("A1").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("A1").Value
.CC = ""
.BCC = ""
.Subject = "SS SHEET and PLATE REQUIREMENTS"
.Body = Format(ThisWorkbook.Sheets("National").Range("Ad1").Value, "VB")
.Attachments.Add wb.FullName
.Display 'disable display and enable send to send automatically
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