Control button to create a one time folder, save with date and send work sheet to email

[karol polubinski]

I have tried to write a long code, i ADMIT i AM A BEGINNER.

Sub AFolderVBA2()
Dim i As Integer

For i = 1 To 5
MkDir "C:\Users\kapo\Desktop\Catering\Weekly food Order\" & Range("A" & i)
Next i
End Sub
Sub Save()
ActiveWorkbook.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order\file00-00-2000\.xlsm", FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Private Sub
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Weekly Order Note"
.Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
.Attachments.Add Application.ActiveWorkbook.FullName
.Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

End

I cannot get anything to work.

Is there anyone who can give me a help please

[#2]

Karol-

Everyone has to start somewhere!  I'm happy to assist you.  I have made some code comments below to help explain what the code is doing and where you may have potentially gone wrong.  Please let me know if you need more assistance.  It may help if you can explain in more detail what you are trying to accomplish.

Sub AFolderVBA2()

    Dim i As Integer
    
    For i = 1 To 5
        'This will iterate through Range A1 to Range A5. and make a new folder directory labeled as such...
         MkDir "C:\Users\kapo\Desktop\Catering\Weekly food Order\" & Range("A" & i)
    Next i

End Sub

Sub Save()
    'Saves this workbook in the following path
    ActiveWorkbook.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order\file00-00-2000\.xlsm", FileFormat _
    :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Sub SendMail()

    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    
    'Supress Errors
    On Error Resume Next
    
    'Create email....
    With OutlookMail
        .To = "" 'You need a recipient...
        .CC = ""
        .BCC = ""
        .Subject = "Weekly Order Note"
        .Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
        .Attachments.Add Application.ActiveWorkbook.FullName 'This will attach the ActiveWorkbook (This workbook)
        .Display 'This displays the email you are about to send.
                 'You can use this line until the process works perfectly.
                 'Then you can change it back to using .Send
        '.Send
    End With
  
End Sub

[#3]

Hi there,

you are my savour.

thank you for your help.

Do you mind if it get back to the subject tomorrow.

I must admit I nearly gave up and binned the whole project.

good before deleting I came back here and saw you response.

thank you very very much

I will be back tomorrow

[#4]

Karol-

Sure thing.  I'll wait for your response tomorrow.  Look forward to helping you resolve your issue!

[#5]

Good Morning Matt,

I am trying to create a button that is multi tasking not to create clutter of the worksheet.

The workbook consists of 8 work sheets but only one work sheet is the main important one.

the Code I tried to write is

If there is not present the the food order folder it  has to create one folder a one time thing.

C:\user\kapo\desktop\Catering\WEEKLY FOOD ORDER(if this is not thereto create it once)

the work sheet called order summery the only one that needs to be saved has to be automatically saved and renamed as food order 24.05.2018 and each time it is used the button after creating the folder it will only have to save worksheet call order summary save it as food order and the date.

once it has done all the saving part it needs to automatically attach the saved file to outlook in an e-mail and automatically send to 2 specific receivers in address in the to area and the other in the cc area.

after it has done that its the end of the function.

I hope this time I managed to explain better what I am trying to do.

what I did before was from the little Iknow I tried to merge 2 codes into onew to do the job.

[#6]

Hi there,

I tried to do some alterations as regards to the code and it is giving me errors.

As you can see I Linked to to command button 3

it did not create the folder called weekly food order but if I am not mistaken it should do it due to the code

Private Sub CommandButton3_Click()
Sub AFolderVBA2()

Dim i As Integer

For i = 1 To 5
MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
Next i

End Sub

Sub Save()
here I changed it to not save the whole workbook but to just save the worksheet called order summery

ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "DD-MMM-YYYY).xlsm", FileFormat _
:=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False
End Sub

here it is not attaching the file saved it is only showing me the message with no attachment.
Sub SendMail()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next


With OutlookMail
.To = "campboss@suisca.com"
.CC = ""
.BCC = ""
.Subject = "Weekly Order Note"
.Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
.Attachments.Add Application.ActiveWorksheet.FullName '
.Display

End With

End Sub

and part of the cod is high lighted in red the save part and the email part has a yellow arrow.

[#7]

The whole book is called food order book with Macro

I have altered the code you gave me (trying to fit all that I need)

I have done some adjustments

see below:

Private Sub CommandButton3_Click()
Sub AFolderVBA2()

Dim i As Integer

For i = 1 To 5
MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
Next i

End Sub

Sub Save()

I have changed it to work sheet as I only want the order summary sheet to be saved with the currwent date of the order made.

ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "weekly order DD-MM-YYYY).xlsm", FileFormat _
:=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False
End Sub

Sub SendMail()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next


With OutlookMail
.To = "campboss@suisca.com"
.CC = ""
.BCC = ""
.Subject = "Weekly Order Note"
.Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
.Attachments.Add Application.weekly order +date '
.Display

End With

End Sub

please see attached errors of mine.

all help provided is reallymuchappreciated 

[#8]

The whole book is called food order book with Macro

I have altered the code you gave me (trying to fit all that I need)

I have done some adjustments

see below:

Private Sub CommandButton3_Click()
Sub AFolderVBA2()

Dim i As Integer

For i = 1 To 5
MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
Next i

End Sub

Sub Save()

I have changed it to work sheet as I only want the order summary sheet to be saved with the currwent date of the order made.

ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "weekly order DD-MM-YYYY).xlsm", FileFormat _
:=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False
End Sub

Sub SendMail()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next


With OutlookMail
.To = "campboss@suisca.com"
.CC = ""
.BCC = ""
.Subject = "Weekly Order Note"
.Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
.Attachments.Add Application.weekly order +date '
.Display

End With

End Sub

please see attached errors of mine.

all help provided is reallymuchappreciated 

[#9]

Try changing this procedure as follows:

Sub Save()

    'I have changed it to work sheet as I only want the order summary sheet to be saved with the currwent date of the order made.
    
    ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "DD-MM-YYYY") & ".xlsm", FileFormat _
    :=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False

End Sub

[#10]

I am getting still Errors for some sort of unknown reason.

May be its the other button formulas that are malfunctioning?

I think I am not understanding well the book VBA code for dummies. 

So far each for each code and formula when I became too Difficult I had to ask for help.

at times I find writing a code not so logical.

Even my copy and paste code seems to be messed up.

Cannot attach the book as the website removes it 

---

Private Sub CommandButton3_Click()
Sub AFolderVBA2()

 Dim i As Integer
 
 For i = 1 To 5
 MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
 Next i

End Sub

Sub Save()
  ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "DD-MM-YYYY") & ".xlsm", FileFormat _
 :=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False

End Sub

Sub SendMail()

 Dim OutlookApp As Object
 Dim OutlookMail As Object
 Set OutlookApp = CreateObject("Outlook.Application")
 Set OutlookMail = OutlookApp.CreateItem(0)
 
 
 On Error Resume Next
 
 
 With OutlookMail
 .To = "campboss@suisca.com"
 .CC = ""
 .BCC = ""
 .Subject = "Weekly Order Note"
 .Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
 .Attachments.Add Application.ActiveWorksheet.FullName '
 .Display
 
 End With
 
End Sub



Private Sub CommandButton4_Click()

 Range("G12").Copy
 Range("G2666").PasteSpecial Paste:=xlPasteFormats
 
 'Copy and PasteSpecial a between worksheets
 Worksheets("Sheet1").Range("A2").Copy
 Worksheets("Sheet4").Range("A2").PasteSpecial Paste:=xlPasteFormulas
 
 'Copy and PasteSpecial between workbooks
 Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Copy
 Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteFormats
 
 'Disable marching ants around copied range
 Application.CutCopyMode = False

End Sub
End Sub

Private Sub CommandButton5_Click()
Dim sbClearCellsOnlyData()
Range("G12:G2666").ClearContents
End Sub


Private Sub CommandButton6_Click()

End Sub

Private Sub CommandButton7_Click()

Application.Dialogs(xlDialogPrint).Show

End Sub

[#11]

Karol-

Before attaching a file try using the VBA code below (You have Additional End Sub and Private Sub XXXX()  statements that needed to be removed.  They need to be paired together.)  If this code won't work then go ahead and use my below instructions to attach the file. :

Sub AFolderVBA2()

 Dim i As Integer
 
 For i = 1 To 5
 MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
 Next i

End Sub

Sub Save()
  ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "DD-MM-YYYY") & ".xlsm", FileFormat _
 :=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False

End Sub

Sub SendMail()

 Dim OutlookApp As Object
 Dim OutlookMail As Object
 Set OutlookApp = CreateObject("Outlook.Application")
 Set OutlookMail = OutlookApp.CreateItem(0)
 
 
 On Error Resume Next
 
 With OutlookMail
 .To = "campboss@suisca.com"
 .CC = ""
 .BCC = ""
 .Subject = "Weekly Order Note"
 .Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
 .Attachments.Add Application.ActiveWorksheet.FullName '
 .Display
 
 End With
 
End Sub

Private Sub CommandButton4_Click()

 Range("G12").Copy
 Range("G2666").PasteSpecial Paste:=xlPasteFormats
 
 'Copy and PasteSpecial a between worksheets
 Worksheets("Sheet1").Range("A2").Copy
 Worksheets("Sheet4").Range("A2").PasteSpecial Paste:=xlPasteFormulas
 
 'Copy and PasteSpecial between workbooks
 Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Copy
 Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteFormats
 
 'Disable marching ants around copied range
 Application.CutCopyMode = False

End Sub

Private Sub CommandButton5_Click()
Dim sbClearCellsOnlyData()
Range("G12:G2666").ClearContents
End Sub


Private Sub CommandButton7_Click()

Application.Dialogs(xlDialogPrint).Show

End Sub

Try saving the file as an .xlsx.  Then post it to the forum along with the code you have written.  The forum doesn't allow you to attach macro enabled workbooks because of security risks.

[#12]

Hi Matt,

the Below I have repaired and modified and they seem to work fine.

I upgraded my skill with adding message boxes.

Please See below:

Private Sub CommandButton5_Click()
Dim sbClearCellsOnlyData()
Range("G12:G2666").ClearContents
MsgBox "Contents From Quantity Recieved Cleared, Action Completed"
End Sub

Private Sub CommandButton6_Click()

Dim a As Long
For a = 2 To Sheets.Count
Worksheets(a).Range("E4:E1500").ClearContents
Next a
MsgBox "Contents of All Order Sheets Cleared, Action Completed"
End Sub

Private Sub CommandButton7_Click()

Application.Dialogs(xlDialogPrint).Show

End Sub

after some playing around with the code I got it working and buttons 5,6,7 are working really fine.

My only issue is that blessed create folder, save work sheet with current date, attach to email and send.

please see attached error.

[#13]

here is the excel file save without Macro.

please see attached

Code Being used is as follows:

if you look at my previous message you can see the error.

Private Sub CommandButton3_Click()
Sub AFolderVBA2()

Dim i As Integer

For i = 1 To 5
MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
C:\Users\kapo\Desktop\Suisca Catering\Weekly Food Order
Next i

End Sub

Sub Save()

ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "DD-MM-YYYY") & ".xlsm", FileFormat _
:=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False

End Sub

Sub SendMail()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next


With OutlookMail
.To = "campboss@suisca.com"
.CC = ""
.BCC = ""
.Subject = "Weekly Order Note"
.Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
.Attachments.Add Application.ActiveWorksheet.FullName '
.Display

End With

End Sub

[#14]

here is the excel file save without Macro.

please see attached

Code Being used is as follows:

if you look at my previous message you can see the error.

Private Sub CommandButton3_Click()
Sub AFolderVBA2()

Dim i As Integer

For i = 1 To 5
MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
C:\Users\kapo\Desktop\Suisca Catering\Weekly Food Order
Next i

End Sub

Sub Save()

ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "DD-MM-YYYY") & ".xlsm", FileFormat _
:=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False

End Sub

Sub SendMail()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next


With OutlookMail
.To = "campboss@suisca.com"
.CC = ""
.BCC = ""
.Subject = "Weekly Order Note"
.Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
.Attachments.Add Application.ActiveWorksheet.FullName '
.Display

End With

End Sub

[#15]

here is the excel file save without Macro.

please see attached

Code Being used is as follows:

if you look at my previous message you can see the error.

Private Sub CommandButton3_Click()
Sub AFolderVBA2()

Dim i As Integer

For i = 1 To 5
MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
C:\Users\kapo\Desktop\Suisca Catering\Weekly Food Order
Next i

End Sub

Sub Save()

ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "DD-MM-YYYY") & ".xlsm", FileFormat _
:=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False

End Sub

Sub SendMail()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next


With OutlookMail
.To = "campboss@suisca.com"
.CC = ""
.BCC = ""
.Subject = "Weekly Order Note"
.Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
.Attachments.Add Application.ActiveWorksheet.FullName '
.Display

End With

End Sub

[#16]

here is the excel file save without Macro.

please see attached

Code Being used is as follows:

if you look at my previous message you can see the error.

Private Sub CommandButton3_Click()
Sub AFolderVBA2()

Dim i As Integer

For i = 1 To 5
MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
C:\Users\kapo\Desktop\Suisca Catering\Weekly Food Order
Next i

End Sub

Sub Save()

ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Catering\Weekly food Order " & Format(Now(), "DD-MM-YYYY") & ".xlsm", FileFormat _
:=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False

End Sub

Sub SendMail()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next


With OutlookMail
.To = "campboss@suisca.com"
.CC = ""
.BCC = ""
.Subject = "Weekly Order Note"
.Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
.Attachments.Add Application.ActiveWorksheet.FullName '
.Display

End With

End Sub

[#17]

Try using this code.  Not really sure what you want to do with the  AFolderVBA2 Procedure.  I wrote some notes in my comments that should help clarify what the code is doing....

Private Sub CommandButton3_Click()
    'This calls the three procedures in sucession
    Call AFolderVBA2 'Create Folders
    Call SaveSht 'Save Worksheet
    Call SendMail 'Create Email and display it
End Sub

Sub AFolderVBA2()

Dim i As Integer

For i = 1 To 5

    'THis takes the values for Cells A1-A5 on the Order Summary Tab...
    'It doesn't look like this is what you should use...
    'What directories do you want created?

    MkDir "C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Range("A" & i)
Next i



End Sub

Sub SaveSht()

'Save is a reserved word.  It's best not to name a procedure with this naming convention
'I have altered the procedure name to SaveSht

ActiveWorksheet.SaveAs Filename:="C:\Users\kapo\Desktop\Suisca Catering\Weekly food Order\" & Format(Now(), "DD-MM-YYYY") & ".xlsm", FileFormat _
:=xlOpenXMLWorksheetkMacroEnabled, CreateBackup:=False

End Sub

Sub SendMail()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

On Error Resume Next

With OutlookMail
    .To = "campboss@suisca.com"
    .CC = ""
    .BCC = ""
    .Subject = "Weekly Order Note"
    .Body = "Good Day to All, Please find Attached order sheet for the week. Please Acknowledge reciept of the attached document, thank you. Best Regards, Camp Boss"
    .Attachments.Add Application.ActiveWorksheet.FullName
    .Display
    '.Send 'uncomment this line if you want to send the email rather than display it...
End With

End Sub

[#18]

Hi Matt,

Good Morning, I have realised I did a mistake while think well about the whole process I figured out that you were correct I cannot only save the worksheet but the entire work book.

I will try to modify the code and hope I leave it working well.