email active sheet via VBA

[bc320]

I have the below macro set to email the active sheet. It copies the sheet to a new file and saves as a temp file. This sheet contains a lot of formulas that reference other sheets that are not included. When the end user opens the sheet they are asked to "Continue" or "Edit Links" and regardless of the choice, there are #ref errors for some of the values.

I would like to somehow copy a specific range of cells on the temp sheet, copy, and paste as values.
There is a commented out part that says "Change all cells in the worksheet to values if you want" but whenever I try to get that line to work the code crashes.


Sub EmailVOC()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
* * Dim FileExtStr As String
* * Dim FileFormatNum As Long
* * Dim Sourcewb As Workbook
* * Dim Destwb As Workbook
* * Dim TempFilePath As String
* * Dim TempFileName As String
* * Dim OutApp As Object
* * Dim OutMail As Object

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

* * Set Sourcewb = ActiveWorkbook

* * *'Copy the sheets to a new workbook
* * 'We add a temporary Window to avoid the Copy problem
* * 'if there is a List or Table in one of the sheets and
* * 'if the sheets are grouped
* * With Sourcewb
* * * * Set TheActiveWindow = ActiveWindow
* * * * Set TempWindow = .NewWindow
* * * * .Sheets(Array(ActiveSheet.Name)).Copy
* * End With
* * *'Close temporary Window
* * TempWindow.Close
* *
* * Set Destwb = ActiveWorkbook

* * 'Determine the Excel version and file extension/format
* * With Destwb
* * * * If Val(Application.Version) < 12 Then
* * * * * * 'You use Excel 97-2003
* * * * * * FileExtStr = ".xlsx": FileFormatNum = -4143
* * * * Else
* * * * * * 'You use Excel 2007-2013
* * * * * * FileExtStr = ".xlsx": FileFormatNum = 51
* * * * End If
* * End With

* * ' * *'Change all cells in the worksheet to values if you want
* * ' * With Destwb.Sheets.UsedRange
* * ' * * * *.Cells.Copy
* * ' * * * *.Cells.PasteSpecial xlPasteValues
* * ' * * * *.Cells.Select
* * ' * *End With
* * * * Application.CutCopyMode = False

* * 'Save the new workbook/Mail it/Delete it
* * TempFilePath = Environ$("temp") & "\"
* * TempFileName = ActiveSheet.Range("C1").Value

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

* * With Destwb
* * * * .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
* * * * On Error Resume Next
* * * * With OutMail
* * * * * * .To = ""
* * * * * * .CC = ""
* * * * * * .BCC = ""
* * * * * * .Subject = ""
* * * * * * .Body = ""
* * * * * * .Attachments.Add Destwb.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

* * 'Delete the file you have send
* * Kill TempFilePath & TempFileName & FileExtStr

* * Set OutMail = Nothing
* * Set OutApp = Nothing

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

[Richard Buttrey]

Hi,

We generally prefer to work with the actual workbook.

Please upload it and make sure the macro is readable without all the *** stuff

[bc320]

The sheet and workbook contain way too much personal information to upload it to a forum site.
Not sure why paste is adding the **. No matter how I wrap the text, the preview looks good then the post adds the **

[Richard Buttrey]

The sheet and workbook contain way too much personal information to upload it to a forum site.
Not sure why paste is adding the **. No matter how I wrap the text, the preview looks good then the post adds the **

We don't need the personal information and don't mind how many D Ducks, or M Mouse it contains, just remove all but a few names and anonymise them.
We really prefer to see the workbook.

[bc320]

You don't understand. This workbook contains more than just names. It has very sensitive data that will requires hours to scrub. Along with the bulk of the code because it too could be used to glean sensitive data. Mostly likely by the time I am done scrubbing, what is left will not work at all.

[Richard Buttrey]

It's your decision.

I'd question whether deleting all but a half a dozen rows on a sheet then manually or semi-automatically with some formulae would take hours.

If you seek answers we're prepared to help but not jump through hoops spending time trying to work through some disconnected code which we can't test in situ.

As I say, your call.

[maniacb]

Here is a simple thing to try.

Change

Please Login or Register  to view this content.

to

Please Login or Register  to view this content.

If this doesn't help, we'll need to see a sample file as Richard requests.