Forum Discussion

Brass Contributor

May 22, 2018

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

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 E...

Macros and VBA

Matt Mickle

Bronze Contributor

May 24, 2018

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.

karol polubinski

Brass Contributor

May 24, 2018

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

Food Order Book without Marco.xlsx206 KB

Matt Mickle

Bronze Contributor

May 25, 2018

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

karol polubinski
Brass Contributor
May 25, 2018
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.