Email VBA works, have question.

P

pujo

Well-known Member
Joined
Feb 19, 2009
Messages
710
Office Version
  1. 2019
  2. 2013
Platform
  1. Windows
I am using Mr. Bruins code to send email.
It works great. The only thing it doesn't do is add my signature.
Is there any way to implement this into the code?
Here is what I have.
Code: 
Sub Mail_workbook_Outlook_1()
'Working in 2000-2007
'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "me@me.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Sort by date Sort by votes
My bad - try

Code: 
SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\*.htm"

    'SigString = "C:\Users\" & Environ("knormand") & _
     "\AppData\Roaming\Microsoft\Signatures\Mysig.htm"
    Dim Try As String
    Try = Dir(SigString)

    If Try <> "" Then
    SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\" & Try
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
 
Upvote 0

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
I don't know how you do it.
But it works.

I would like to be able to figure these things out for myself and make my own code. Where would be a good place to start to learn VBA?

Thanks a million
again,
Your The Man !
 
Upvote 0
If you have time, look at this and see if you see any problems.
It is working for sending email, but not inserting the signature.
(I tried to incorporate the code into this script) Its not pretty, but it does work. the code I tried to incorporate is in RED
Only if you have time.
:biggrin:

Rich (BB code): 
Private Sub CommandButton1_Click()
'Working in 2000-2007
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A5:K32").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "" & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "??@??.com"
            .CC = "??@??.com"
            .BCC = ""
            .Subject = "Caesar Production"
            .body = "Good Morning.   Please see attached file."
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


Sub Mail_Selection()
'Working in 2000-2007
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If

    If ActiveWindow.SelectedSheets.Count > 1 Or _
       Selection.Cells.Count = 1 Or _
       Selection.Areas.Count > 1 Then
        MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
               "You have more than one sheet selected." & vbNewLine & _
               "You only selected one cell." & vbNewLine & _
               "You selected more than one area." & vbNewLine & vbNewLine & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "??@??.com"
            .CC = "??@??.com"
            .BCC = ""
            .Subject = "Caesar Production"
            .body = "Good Morning, please see attachment."
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub



Private Sub CommandButton2_Click()
'Working in 2000-2007
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A1:AJ117").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "" & wb.Name & " " & Format(Now, "mmm-dd-yy")

    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    If Try <> "" Then
    SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\" & Try
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "Morning Report"
            .CC = ""
            .BCC = ""
            .Subject = "SS-332B Morning Report"
            .body = "Good Morning.   Please see attached file."
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAstextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function


Sub Mail_Selection1()
'Working in 2000-2007
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If

    If ActiveWindow.SelectedSheets.Count > 1 Or _
       Selection.Cells.Count = 1 Or _
       Selection.Areas.Count > 1 Then
        MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
               "You have more than one sheet selected." & vbNewLine & _
               "You only selected one cell." & vbNewLine & _
               "You selected more than one area." & vbNewLine & vbNewLine & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Selection of " & wb.Name & " " & Format(Now, "mmm-dd-yy")

    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "Morning Report"
            .CC = ""
            .BCC = ""
            .Subject = "SS-332B Morning Report"
            .body = "Good Morning, please see attachment."
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Private Sub CommandButton3_Click()
Application.ActivateMicrosoftApp Index:=0
End Sub

Private Sub CommandButton4_Click()
ChDir "\\D00011405\CHOPS\CHOPS Pigging report"
    Workbooks.Open Filename:= _
        "\\D00011405\CHOPS\CHOPS Pigging report\CHOPS Pigging Calculator (2).xls"
End Sub

Private Sub CommandButton5_Click()
 ChDir "\\D00011405\chops\CHOPS Pigging report"
    Workbooks.Open Filename:= _
        "\\D00011405\chops\CHOPS Pigging report\Pigging History.xls"
End Sub

'*************************************************************************
Private Sub Worksheet_Deactivate()
Response = MsgBox("Please Fully Complete The Morning Report Before Filling Out The Daily Summary. The Morning Report Must Be Complete Before The Daily Summary", vbYesNo)

If Response = vbYes Then GoTo GoodToGo

Sheets("Morning Report").Activate

GoodToGo:

End Sub
'*************************************************************************
 
Upvote 0
Try this (untested)

Rich (BB code): 
Private Sub CommandButton2_Click()
'Working in 2000-2007
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim SigString As String
    Dim Signature As String
    Dim Try As String
    Dim strbody As String

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A1:AJ117").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "" & wb.Name & " " & Format(Now, "mmm-dd-yy")

    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\*.htm"

    Dim Try As String
    Try = Dir(SigString)

    If Try <> "" Then
    SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\" & Try
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
    strbody = "Good Morning.   Please see attached file."
    On Error Resume Next
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "Morning Report"
            .CC = ""
            .BCC = ""
            .Subject = "SS-332B Morning Report"
            .HTMLBody = strbody & "<br><br>" & Signature

            .Attachments.Add Dest.FullName

            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAstextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
 
Upvote 0
Here we go again.
This is the last report in my workbook, and I can not get it to insert the signature in the email. Please look at it and see what I did wrong.
Also, when I send the reports out as email attachments, and the recipients open the the file the zoom is set to 100%
I work the report in 75% zoom. Is there anything I can do about this?
Anyway, here is the code in question.
Many Thanks.
pujo
Code: 
 Private Sub CommandButton1_Click()
'Produced By Kyp Normand
ActiveSheet.Unprotect Password:="18436572"
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("B2:S36").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "" & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\*.htm"

    'SigString = "C:\Users\" & Environ("UserName") & _
     "\AppData\Roaming\Microsoft\Signatures\Mysig.htm"
    Dim Try As String
    Try = Dir(SigString)

    If Try <> "" Then
    SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\" & Try
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
    strbody = "Good Morning,     Please see attached file."
    On Error Resume Next
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "Daily Summary"
            .CC = ""
            .BCC = ""
            .Subject = "Daily Summary"
            .HTMLbody = "Good Morning.   Please see attached file."
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="18436572"
    End With
End Sub


Sub Mail_Selection()

    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If

    If ActiveWindow.SelectedSheets.Count > 1 Or _
       Selection.Cells.Count = 1 Or _
       Selection.Areas.Count > 1 Then
        MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
               "You have more than one sheet selected." & vbNewLine & _
               "You only selected one cell." & vbNewLine & _
               "You selected more than one area." & vbNewLine & vbNewLine & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
         
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
         
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "Daily Summary"
            .CC = ""
            .BCC = ""
            .Subject = "Daily Summary"
            .HTMLbody = "Good Morning, please see attachment."
            .Attachments.Add Dest.FullName
             
             
            .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAstextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
 
Upvote 0
Again PERFECT
What about the page being zoomed out to 100% when the recipient opens the attachment. anything?
 
Upvote 0
Untested:

Rich (BB code): 
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
        ActiveWindow.Zoom = 75
    End With
 
Upvote 0
Is there anything you can't figure out?
How many years do you have fooling around with this stuff.

If you ask me about electronics, Instrumentation, I could talk you a good game, that is my living. This stuff! I am as dumb as they come.

I have to find something you can't figure out! Ha!

I am sure I will think of something else to ask you later, until then,
Have a great Day, and remember.

as we say here in Louisiana

sher, you da man!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Add Outlook "Confidential" Sensitivity Label
Replies
2
Views
178
Aviles
A
S
  • Question Question
VBA sending an email of two conditions are met
Replies
5
Views
243
mumps
mumps
K
  • Solved
Macro : Email Worksheet As PDF
Replies
3
Views
478
Domenic
D
K
  • Question Question
Call cell value Macro
Replies
1
Views
219
karldugan
K
C
  • Question Question
VBA to save file to SharePoint and attach to outlook template saved in SharePoint
Replies
6
Views
250
Chris8630
C

Forum statistics

Threads
1,224,599
Messages
6,179,827
Members
452,946
Latest member
JoseDavid

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top