Help with outlook VBA code

[Drewbert34]

I need for this code to convert a XLSM file to XLSX prior to attaching it to the email. In my newly aquired VBA experience everything I've tried and studied has failed. Does anyone have any suggestions? Thank you for your time!

Sub StoreNet()
'
' StoreNet Macro
'
'
Application.Run "'Store Projects Schedules-2011.xlsm'!StoreNet1"
Sheets("Commercial Upgrades Projects").Select
Application.Run "'Store Projects Schedules-2011.xlsm'!StoreNet2"
Application.Run "'Store Projects Schedules-2011.xlsm'!DeleteAllCode"

' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
Set wb1 = ActiveWorkbook
If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
"be no VBA code in the file you send. Save the" & vbNewLine & _
"file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Make a copy of the file.
' If you want to change the file name then change only TempFileName variable.
TempFilePath = Environ$("temp") & "\"
TempFileName = Range("'Drop Down Selections'!B2")
FileExtStr = "." & LCase(Right(wb1.Name, _
Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run this procedure.
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Weekly Formatted Schedule"
.Body = "Attached is the weekly formatted schedule. Thank You!"
.Attachments.Add wb2.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
wb2.Close SaveChanges:=False
' Delete the file.
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing

MsgBox "Macro Complete!Click Ok to close workbook (prevents accidental saving/overwriting of schedule)"
ActiveWorkbook.Close False
' closes the active workbook without saving any changes
With Application
.ScreenUpdating = True
.EnableEvents = True

End With
End Sub

 

[niceguy_jay]

Sub StoreNet()
'
' StoreNet Macro
'
'
'Application.Run "'Store Projects Schedules-2011.xlsm'!StoreNet1"
'Sheets("Commercial Upgrades Projects").Select
'Application.Run "'Store Projects Schedules-2011.xlsm'!StoreNet2"
'Application.Run "'Store Projects Schedules-2011.xlsm'!DeleteAllCode"
'
'' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
Set wb1 = ActiveWorkbook
If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
"be no VBA code in the file you send. Save the" & vbNewLine & _
"file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Make a copy of the file.
' If you want to change the file name then change only TempFileName variable.
TempFilePath = Environ$("temp") & "\"
TempFileName = Range("'Drop Down Selections'!B2")
FileExtStr = "." & LCase(Right(wb1.Name, _
Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1))) & "x"
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run this procedure.
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Weekly Formatted Schedule"
.Body = "Attached is the weekly formatted schedule. Thank You!"
.Attachments.Add wb2.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
wb2.Close SaveChanges:=False
' Delete the file.
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing

MsgBox "Macro Complete!Click Ok to close workbook (prevents accidental saving/overwriting of schedule)"
ActiveWorkbook.Close False
' closes the active workbook without saving any changes
With Application
.ScreenUpdating = True
.EnableEvents = True

End With
End Sub

try this...

 

[Drewbert34]

try this...

It sent the email without the attachment.

 

[Drewbert34]

It sent the email without the attachment.

It appears the only change was "& "x" to this line?:

FileExtStr = "." & LCase(Right(wb1.Name, _
Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1))) & "x"

Just trying to learn the logic and make sure I catch what you are trying to do and why.

 

[Drewbert34]

I'm still trying to figure this out to no avail. I just thought I would check here 1 more time to see if anyone had any sugestions?