Macro to delete first row and send an email with attachment

Good day,

At the moment i'm writing a macro to send an email with an attachment.

What i would like is for the macro to delete the first row of the file and then shift the row up and then send the email , this is what i have so far :

Private Sub CommandButton1_Click()


    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim objOutlookRecip As String
    On Error Resume Next
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
      xMailBody = "Body content" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
              
                  On Error Resume Next
  

With xOutMail
   .To = "testemaill"
        .CC = ""
        .BCC = ""
        .Subject = "Test email send by button clicking"
        .Body = xMailBody
        .Display   'or use .Send
'Add attachments to the message [some code]
   .Attachments.Add "C:\Users\user\Desktop\Test\testfile.xlsx"

   
End With
Set objOutlook = Nothing

End Sub

The above successfully attaches the file to the email.

i know the line to delete the first row is

Rows(1).EntireRow.Delete

, but i'm not sure how to refer it to that specific file and have it run before attaching it to the email.

There's about 20 files that i want to do this with and run it every first day of the month , are there any macros that would make this task easier?

Any help would be appreciated.

Kind regards
Rynhardt

Hi Aredeekay

Welcome to the Forum.
In future please view the forum rules before posting. Your post does not comply with rule #3.
3. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing.
So, do the following:
Edit your post, highlight your code and click the [#] button at the top of the post window.

You are gonna have to incorporate code to first delete the first row of the file and then attach it to send...
So code will loop through your 20 files, delete the first row and then attache and send...

Edit...

Explain your setup and I am sure we will be able to assist...
Must the email be sent with all 20 attachments
Sent to same person, multiple people
Individual attachment per email etc etc..

So, upload a sample file and tell us where the 20 files are saved...i.e. path and folder and we can assist with some code...
Is it being sent to the same mail address all the time?

To attach a file, click on Go Advanced (below the Edit Window) while you are composing a reply, then scroll down to and click on Manage Attachments and the Upload window will open. Click on Browse and navigate to (and double-click) the file icon that you want to attach, then click on Upload and then on Close this Window to return to the Edit window. When you have finished composing your post, click on Submit Post.

There's about 20 files that i want to do this with

My understanding is as follows...

You need code to loop through 20 files...Delete the first row within the file...attach the file to an email and send to Recipient
then close file and open next file and do the same
Until all files have been sent...

All 20 files are in the same folder on same path...C:\Users\me\Desktop\UT Admin

okay...Play around with this...
Save the attached file in the folder called UT Admin which houses the folder Test
So in UT Folder you will have Folder called TEST and file called Aredeekay.xlsm
Then open this file and run the code...
It will loop through all 20 files in the folder called Test, delete the first row of active sheet, add the file to email and display...
then close and do next one etc etc etc...

Option Explicit

Sub Aredeekay()
Dim Fso As Object, objFolder As Object, File As Object
Dim path As String, Fl As String
Dim wb As Workbook
Application.ScreenUpdating = False
path = ThisWorkbook.path & "\Test\"
Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(path)
For Each File In objFolder.Files
    Set wb = Workbooks.Open(File)
    Fl = wb.Name
        With wb.ActiveSheet
            .Rows(1).Delete
        End With
        With CreateObject("Outlook.Application").Createitem(0)
            .To = "Excel@Forum.com"
            .Subject = "Sending File"
            .Body = "Hi Please see attached"
            .Attachments.Add path & "\" & Fl
            .Display '.Send
        End With
        Application.DisplayAlerts = False
        wb.Close savechanges:=True
        Application.DisplayAlerts = True
Next File
Application.ScreenUpdating = True
End Sub

Thanks a lot, this works.

Would it be possible to add an excel & pdf file with a specific name with a similar macro as this?

For example : in the folder Test we have 20 excel files and each 1 is accompanied by a pdf file with a similar name, or would that require 20 difference macros?

Edit : Regarding the original code you posted above, it attaches the file first before deleting the row , so only after it sent the first row is deleted , is there any way it could delete the first row and then send it as an attachment afterwards?

20 excel files and each 1 is accompanied by a pdf file with a similar name

Revised code will attach pdf if name is same i.e File1.xlsx & File1.pdf

Regarding the original code you posted above, it attaches the file first before deleting the row

Below changes will solve

Option Explicit

Sub Aredeekay()
Dim Fso As Object, objFolder As Object, File As Object
Dim path As String, Fl As String, Flpdf As String
Dim wb As Workbook
Application.ScreenUpdating = False
path = ThisWorkbook.path & "\Test\"
Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(path)
For Each File In objFolder.Files
    If File.Name Like "*.xlsx" Then
        Set wb = Workbooks.Open(File)
        Fl = wb.Name
        Flpdf = Replace(Fl, "xlsx", "pdf")
            With wb.ActiveSheet
                .Rows(1).Delete
            End With
            wb.save
            With CreateObject("Outlook.Application").Createitem(0)
                .To = "Excel@Forum.com"
                .Subject = "Sending File"
                .Body = "Hi Please see attached"
                .Attachments.Add path & "\" & Fl
                .Attachments.Add path & "\" & Flpdf
                .Display '.Send
            End With
            Application.DisplayAlerts = False
            wb.Close savechanges:=True
            Application.DisplayAlerts = True
    End If
Next File
Application.ScreenUpdating = True
End Sub

............................................
Thanks.gif