PDA

View Full Version : Hoa can I combine the following 3 vba scripts to 1



softman
03-25-2010, 12:58 AM
Below is 3 diffrent VBA scripts I would like to run from one button.
What I want to happen is the first part save the workbook as new file in to a given folder, the second part take that saved file and atatted it as a email and the 3rd part close the workbook. Please advise?




Sub SvMe() 'Save filename as value of A1 plus the current date
Dim newFile As String, fName As String
' Don't use "/" in date, invalid syntax
fName = Range("A1").Value
newFile = fName & " " & Format$(Date, "mm-dd-yyyy")
' Change directory to suit
ChDir _
"C:\Documents and Settings\ USER NAME \Desktop" 'YOU MUST Change USER NAME to suit
ActiveWorkbook.SaveAs Filename:=newFile
End Sub



Option Explicit
Sub Mail_workbook_Outlook_1()
'Working in 2000-2010
'This example send the last saved version of the Activeworkbook
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 = "ron@debruin.nl"
.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")
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Sub Mail_workbook_Outlook_2()
'Working in 2000-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 be no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
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
With OutMail
.to = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add wb2.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
wb2.Close savechanges:=False
'Delete the file
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub



Sub Save_Exit()
Application.Quit
ThisWorkbook.Close SaveChanges:=True
End Sub

(Credit to Zack Barresse and Ron de Bruin)

Bob Phillips
03-25-2010, 02:44 AM
Just have a new procedure triggered by the button that calls each in turn


Sub NewProc

Call Proc1
Call Proc2
Call Proc3
End Sub

Paul_Hossler
03-25-2010, 05:24 AM
If there's any error exits that would mean that the later subs should not run, you might make the 3 subs into 3 functions that return a True/False if that part completed successfully



Sub NewProc
if Not Func1 then
MsgBox "Ooops"
Exit Sub
Endif
if Not Func2 then
MsgBox "Ooops 2"
Exit Sub
Endif
if Not Func3 then
MsgBox "Ooops 3"
Exit Sub
Endif
End Sub





Paul

softman
03-25-2010, 05:28 AM
Thanks VBAX Mentor,

I am very new to VBA and do not understand what to do. What I am looking is for someone that can take the code of the first part and replace it with the second part of the code :

Part 1: safe to folder with specified name as in code
Part 2: take the file that is been safed in that folder and attached to email
Part 3: close file

Thx

Bob Phillips
03-25-2010, 06:07 AM
It is all stated in my post, just follow what I say.

SamT
03-25-2010, 07:38 AM
Softman,

If I understand correctly, you want to eMail a copy of an open file to someone,
AND,
Save the open file to a specific folder,
AND,
Close the Saved file.

The Open file will be closed when it is saved to the specific folder because the saved file will become the new Open File.

Is that right?

Do you want to take out the vba code from the emailed copy and/or the saved file?

softman
03-26-2010, 04:55 AM
VBAX Regular

This is what I want to happen:
Save the copy of the file to a folder with the name of A1 and date and
Send that file in that folder to an email and then close excel
And finally remove any VBA code and save file as .xls


Many thanks

SamT
03-26-2010, 06:16 AM
This is what I want to happen:
Save the copy of the file to a folder with the name of A1 and date and
Send that file in that folder to an email ... And finally remove any VBA code and save file as .xls... and then close excel

Do you want the saved in folder to be named A1.Value & Date or want Saved File named A1.Value & Date?

Also, The process you want will email file with VBA and leave saved email file with VBA in folder and Original file saved with no VBA.

softman
03-26-2010, 06:58 AM
VBAX Regular

I would like to have it saved as the value of A1 & Date and save as .xls
Aslo if possble to remove and VBA or button to VBA

Original fle must still have VBA
Save and email file no VBA

Thanks