Forum Discussion
Control button to create a one time folder, save with date and send work sheet to email
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
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 SubI 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 SubKarol-
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 SubTry 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.
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 iEnd 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 Subplease see attached errors of mine.
all help provided is reallymuchappreciated
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 iEnd 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 Subplease see attached errors of mine.
all help provided is reallymuchappreciated
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.
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 iEnd 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 Subhere 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 Suband part of the cod is high lighted in red the save part and the email part has a yellow arrow.
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
Karol-
Sure thing. I'll wait for your response tomorrow. Look forward to helping you resolve your issue!
