Forum Discussion

karol polubinski's avatar
karol polubinski
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
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

Macros and VBA

17 Replies

  • Matt Mickle's avatar
    Matt Mickle
    Bronze Contributor
    May 22, 2018

    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
    • Matt Mickle's avatar
      Matt Mickle
      Bronze Contributor
      May 24, 2018

      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
      • karol polubinski's avatar
        karol polubinski
        Brass Contributor
        May 24, 2018

        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

    • karol polubinski's avatar
      karol polubinski
      Brass Contributor
      May 24, 2018

      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 

    • karol polubinski's avatar
      karol polubinski
      Brass Contributor
      May 24, 2018

      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 

Resources