Hi
I have following code and want to add to the code that just page one of the sheet will be sent in te email. Is there somene who can help
Private Sub CommandButton1_Click()
Dim OlApp As Object
Dim NewMail As Object
Dim TempFilePath As String
Dim FileExt As String
Dim TempFileName As String
Dim FileFullPath As String
Dim FileFormat As Variant
Dim Wb1 As Workbook
Dim Wb2 As Workbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Wb1 = ThisWorkbook
ActiveSheet.Copy
Set Wb2 = ActiveWorkbook
With Wb2
If Val(Application.Version) < 12 Then
FileExt = ".xls": FileFormat = -4143
Else
Select Case Wb1.FileFormat
Case 51: FileExt = ".xlsx": FileFormat = 51
Case 52:
If .HasVBProject Then
FileExt = ".xlsm": FileFormat = 52
Else
FileExt = ".xlsx": FileFormat = 51
End If
Case 56: FileExt = ".xls": FileFormat = 56
Case Else: FileExt = ".xlsb": FileFormat = 50
End Select
End If
End With
TempFilePath = Environ$("temp") & ""
TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss")
FileFullPath = TempFilePath & TempFileName & FileExt
Wb2.SaveAs FileFullPath, FileFormat:=FileFormat
Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)
On Error Resume Next
With NewMail
.To = " receiver"
.CC = ""
.Subject = "Ident"
.Body = "Kan dere vennligst sende Ident"
.Attachments.Add FileFullPath
.Display
End With
On Error GoTo 0
Wb2.Close SaveChanges:=False
Kill FileFullPath
Set NewMail = Nothing
Set OlApp = Nothing
'Now set the application properties back to true
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
What do you mean by only 1 page? how is the sheet formatted?
Its always best to add an example file so we know what you want and how stuff looks
Hi
I mean just sending the first page of the sheet
The button to send the mail is on the second page and I don`t want include that page to the sheet that is sent by the e-mail
Hello,
It would be easier to copy all the data of the rows and columns that you want to send by email and paste in a new sheet and from there send the email,
but I will leave here a way to identify the first page break, I hope I can help.
for this example I used a command button to call the page break identification procedure
Private Sub CommandButton1_Click()
Dim Wsheet As Worksheet
Dim HorizontalPageBreak As HPageBreak
Dim VerticalPageBreak As VPageBreak
Dim rng As Range
Set Wsheet = ActiveSheet ' OR CHANGE TO ANY SHEET NAME YOU WANT: Application.ThisWorkbook.Worksheets ("Sheet1")
' FOR HORIZONTAL PAGE BREAK
For Each HorizontalPageBreak In Wsheet.HPageBreaks
Debug.Print HorizontalPageBreak.Location.Address
Next HorizontalPageBreak
' FOR VERTICAL PAGE BREAK
For Each VerticalPageBreak In Wsheet.VPageBreaks
Debug.Print VerticalPageBreak.Location.Address
Next VerticalPageBreak
' FIRST PAGE BREAK IS ALWAYS (1) ... FOR SECOND PAGE BREAK IS (2) ... etc
Set rng = Wsheet.Range(Wsheet.HPageBreaks(1).Location.Offset(-1, 0), Wsheet.VPageBreaks(1).Location.Offset(0, -1))
Debug.Print rng.Address
rng.Select
MsgBox "All ranges of the page break: " & rng.Address
If Not Wsheet Is Nothing Then Set Wsheet = Nothing
If Not rng Is Nothing Then Set rng = Nothing
End Sub
Once the first page break is identified and selected, you can use it to copy this data or send...
Miguel,
Hi
Miguel
Thanks for Your help. I think you are right that it is easier to copy rows and columns to New sheet, also because many cells in the sheet contains link to another sheet in the same Workbook.
Do you have the oppertunity to help me to Write the code for copy rows and columns and send by Outlook mail ?
Thanks for Your help
Bogi
As mentioned earlier - if you add an example workbook we can see what we are dealing with and it makes writting the code much easier
Hi
Her is the Attached file
In the sheet "Rep skjema" are information linked from the sheet "Generell informasjon"
I would like to send the sheet "Rep skjema" by e-mail without teh code, button and links if possible.
The code for sending the e-mail are linked to the button "Send to Nav" which is located on page 2 in the sheet "Rep Skjema"
Hope you can help to modify the code 🙂
No file attached.
Instructions on attaching a file
https://www.myonlinetraininghub.com/excel-forum/forum-rules-and-guides/read-this-first
Hi again
Forgot to Attached the file
If it just the button you want to remove then add in
ActiveSheet.Shapes.Range(Array("CommandButton1")).Delete
after the
Set Wb2 = ActiveWorkbook
Thanks. This was very helpful.
Is it possible to also send the sheet without the code and the links to the other sheets?
Hello,
the Purfleet method is correct, but if you don't want to remove the command button, you can simply make it invisible at the beginning of the procedure and visible at the end
and as there is no more data on your excel sheet below line 53, there is no reason to copy and paste it on another sheet...
Something similar to this:
Application.ThisWorkbook.Worksheets("Rep skjema").Activate
Application.ThisWorkbook.Worksheets("Rep skjema").CommandButton1.Visible = False
&
Application.ThisWorkbook.Worksheets("Rep skjema").Activate
Application.ThisWorkbook.Worksheets("Rep skjema").CommandButton1.Visible = True
I highlighted the changes in blue, I tested it with my outlook and it worked perfectly
Private Sub CommandButton1_Click()
Dim OlApp As Object
Dim NewMail As Object
Dim TempFilePath As String
Dim FileExt As String
Dim TempFileName As String
Dim FileFullPath As String
Dim FileFormat As Variant
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Application.ThisWorkbook.Worksheets("Rep skjema").Activate
Application.ThisWorkbook.Worksheets("Rep skjema").CommandButton1.Visible = False
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Wb1 = ThisWorkbook
ActiveSheet.Copy
Set Wb2 = ActiveWorkbook
With Wb2
If Val(Application.Version) < 12 Then
FileExt = ".xls": FileFormat = -4143
Else
Select Case Wb1.FileFormat
Case 51: FileExt = ".xlsx": FileFormat = 51
Case 52:
If .HasVBProject Then
FileExt = ".xlsm": FileFormat = 52
Else
FileExt = ".xlsx": FileFormat = 51
End If
Case 56: FileExt = ".xls": FileFormat = 56
Case Else: FileExt = ".xlsb": FileFormat = 50
End Select
End If
End With
TempFilePath = Environ$("temp") & ""
TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss")
FileFullPath = TempFilePath & TempFileName & FileExt
Wb2.SaveAs FileFullPath, FileFormat:=FileFormat
Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)
On Error Resume Next
With NewMail
.To = "ADD YOUR EMAIL HERE"
.CC = ""
.Subject = "Ident"
.Body = "Kan dere vennligst sende Ident"
.Attachments.Add FileFullPath
.Display
End With
On Error GoTo 0
Wb2.Close SaveChanges:=False
Kill FileFullPath
Set NewMail = Nothing
Set OlApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.ThisWorkbook.Worksheets("Rep skjema").Activate
Application.ThisWorkbook.Worksheets("Rep skjema").CommandButton1.Visible = True
End Sub
Miguel,
Hello,
Yes and for that you need to change the CommandButton of the sheet, instead of inserting an Active X control (CommandButton), a control (CommandButton) of the form must be inserted in sheet...
the code instead of being in the sheet module, must be inserted as macro in a module and sign / link the macro to shape (CommandButton control).
I attached a workbook with an example, added a userform that you can delete, just to illustrate how to get the name of the shapes and controls in the excel sheet and how the visible and invisible control works.
I tested it with my outlook and it worked perfectly, I made changes to the macro for this new control (hide or show) to send email.
Miguel,
Hi Miguel
Thanks. It Works perfectly!
Just a last question. Is it possible to "kill" the links as well. The person who will receive this sheet shall fill in cell "H8" and "F35" and sendt it back to me by e-mail. When the person open the sheet he get this Message: "We cant`t update some links in your workbook right now. You can continue without opdating their values, or edit the links you think are wrong. "Continue" "Edit Links..."And then the person who receive the mail have to click on "Continue"
It will be fantastic if it is possible to kill the links in the sheet as well so the sheet that is sendt is free for links.
I appreciate Your help very much
Hello,
in your code, change this part, I highlighted in blue what to add in the code
...
With Wb2
If Val(Application.Version) < 12 Then
FileExt = ".xls": FileFormat = -4143
Else
Select Case Wb1.FileFormat
Case 51: FileExt = ".xlsx": FileFormat = 51
Case 52:
If .HasVBProject Then
FileExt = ".xlsm": FileFormat = 52
Else
FileExt = ".xlsx": FileFormat = 51
End If
Case 56: FileExt = ".xls": FileFormat = 56
Case Else: FileExt = ".xlsb": FileFormat = 50
End Select
End If
If Not IsEmpty(Wb2.LinkSources(xlExcelLinks)) Then
For Each Link In Wb2.LinkSources(xlExcelLinks)
Wb2.BreakLink Link, xlLinkTypeExcelLinks
Next Link
End If
End With
...
Miguel,