Help Saving Current work book Macro

[Houstonking]

Hello I am using below macro to save my current workbook to a location on my desktop and email through out look.

But what its doing is taking just my sheet1 of personal.xls and saving it an attaching in email. What am I doing wrong. Please help.


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 ActiveSheet to a new workbook
Sheet1.Copy
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 = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With

 

[Kenneth Hobson]

When pasting code, please click the # icon and paste between code tags.

Your code does not attach any workbook to Outlook. You Set the SourceWB and DestWB to be ActiveWorkbook. Normally, one might use Workbooks.Add and save it to maybe your Desktop folder. Was that what you needed help with? Here is the path:

CreateObject("WScript.Shell").SpecialFolders("Desktop")

 

[Houstonking]

sorry i just see one line of code - how i can i see the full code.

 

[Kenneth Hobson]

It looks like your pasted code is incomplete. I don't know what you need. Did you need an example to attach a file to an Outlook email?

Normally, one would record a macro to get the syntax for saving the current workbook to the desktop folder. e.g.

ActiveWorkbook.SaveAs CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ActiveWorkbook.Name

One would then run code to delete all sheets but one. Of course if you just want a workbook with one sheet and no macros, an xlsx file type should be saved.

Of course there are several ways to do this sort of thing depending on your goals.

 

[Logit]

.
This will attach the active workbook to an email :

Option Explicit


Sub Mail_workbook_Outlook()


    Dim OutApp As Object
    Dim OutMail As Object


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


    On Error Resume Next
    With OutMail
        .to = "myemail@yahoo.com"
        .CC = ""
        .BCC = ""
        .Subject = "Test"
        .Body = ""
        .Attachments.Add (Application.ActiveWorkbook.FullName)
        
        '.Send
        .display
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[Kenneth Hobson]

Here is another method to save a sheet as an xlsx file.

Sub Main()
  Dim swb As Workbook, twb As Workbook, ws As Worksheet, fn As String
  
  Set swb = ActiveWorkbook
  Set ws = swb.Worksheets("Sheet1")
  
  fn = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
  fn = fn & CreateObject("Scripting.FileSystemObject").GetBaseName(swb.FullName)
  fn = fn & ".xlsx"
  If Dir(fn) <> "" Then
    MsgBox "File exists:" & vbLf & fn, vbCritical, "Macro Ending"
    Exit Sub
  End If
  
  'Set twb = Workbooks.Add
  Application.DisplayAlerts = False
  ws.Copy
  Set twb = ActiveWorkbook
  twb.SaveAs fn, 51
  twb.Close False  'Already saved.
  Application.DisplayAlerts = True
End Sub