VBA Macro Help

[andycapp28]

I have put the code below my issues, it's drawn from other threads I've found.

1.
The FOR loop does not exclude row 2 in Column E(blank email) of my single excel sheet.

2.
I unable to get past the .Attachments.Add it fails to find the files even though I have checked the path.

If I hard code a filename it passes to the sendto.

3.
I get a system administrator bounce back "not received" yet the email address are valid.

4.
It does not seem to be refreshing r.value from column E


Notes;
Column A holds excel filenames I wish to attach to the email address held in Column E

Column A row 2 has 1998GBO.Xls
Column A row 3 has 1995PHO.xls
Column A row 4 has 1998MDE.xls

Column E row 2 has abc@googlemail.com,
E row 3 is blank
E row 4 is andycapp28@googlemail.com

Sub Email_ESS()
'
' Email all supported Evs held in excel file and _
  attach his/her file from Monthly Query results
'

    Dim r As Range, c As Range
    Dim rLookfor As Range
    Dim rLookin As Range
    
    With Application
         Application.ScreenUpdating = False
         Application.EnableEvents = False
    End With
    
    With Worksheets
     ' Set rLookin = Range(Cells(2, "E"), Cells(2, "E").End(xlDown)) TOOK USE of this out as couldn't get to compile
    End With
    
    'For Each r In rLookin TOOK THIS OUT, COULDn't use as not get to compile

    For Each r In Range(Cells(2, "E"), Cells(2, "E").End(xlDown))
        ' Set r = rLookin.Find(r.Value) NOT USING (see above)
        
        If Not r Is Nothing Then
                   
        ESubject = "ESS_Report"
        sendto = r.Value
        NewFileName = r.Offset(0, -4)
        
        Set App = CreateObject("Outlook.Application")
        Set Itm = App.CreateItem(0)

        With Itm
        .Subject = ESubject
        .to = sendto
        .Attachments.Add "G:\Marketing\Management and admin\Monthly Management Reports\ESS & EIT Monthly Reporting\NewFileName" 
        .Send
        End With

        Set App = Nothing
        Set Itm = Nothing
  
        End If
    Next

End Sub

 

[Andrzejek]

2.
I unable to get past the .Attachments.Add it fails to find the files even though I have checked the path.

If I hard code a filename it passes to the sendto.

Do you have a file named "NewFileName" in the path you specified?

And then you said:

Column A holds excel filenames I wish to attach to the email address held in Column E

Column A row 2 has 1998GBO.Xls
Column A row 3 has 1995PHO.xls
Column A row 4 has 1998MDE.xls

So, which files and from what location are you trying to attach?

You may try this:

[blue]
Dim strMyFile As String

strMyFile [/blue]= "G:\Marketing\Management and admin\Monthly Management Reports\ESS & EIT Monthly Reporting\NewFileName"

With Itm
   .Subject = ESubject
   .to = sendto
    [blue]Debug.Print strMyFile[/blue]
   .Attachments.Add [blue]strMyFile [/blue]
   .Send
End With

Have fun.

---- Andy

 

[SkipVought]

Hi,

This does not make sense...

With [b]Worksheets[/b]
' Set rLookin = Range(Cells(2, "E"), Cells(2, "E").End(xlDown)) TOOK USE of this out as couldn't get to compile
End With

You need a SPECIFIC worksheet object...

With Worksheets("[b][i]TheSheetNameContainingThisRange[/i][/b]")
  Set rLookin = .Range(.Cells(2, "E"), .Cells(2, "E").End(xlDown))

assuming that column "E", from row 2, has data in contiguous cells to the intended row.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[MakeItSo]

You might especially want to replace this

.Attachments.Add "G:\Marketing\Management and admin\Monthly Management Reports\ESS & EIT Monthly Reporting\NewFileName"

with this:

.Attachments.Add "G:\Marketing\Management and admin\Monthly Management Reports\ESS & EIT Monthly Reporting\" & NewFileName

Besides: I would recommend NOT using ampersands in folder names. Bad practice.

;-)

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[andycapp28]

Hi All responders, thanks for the ideas.

Skip,

There will be some blank cells in column E, I hoped they would fall out of the FOR LOOP but they do not so what will I need to cater for that.

 

[SkipVought]

The End method STOPS when encountering an empty cell!!!!

With Worksheets("TheSheetNameContainingThisRange")
  Set rLookin = .Range(.Cells(2, "E"), .Cells(.usedrange.rows.count, "E"))

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[andycapp28]

New code but still unable to do the following

For tesing purposes I have removed the sending of email

1. Error as need to ignore Column E cells without email address, if email address exists its in variable r

2. Error the .application.add is failing to find the excel file to attach. I can confirm that exists as per the full path I have coded. Its name matches that retrieved from Col A and held in variable EFilename

3. System admin message returned from outlook "unable to send.

Sub ESS_Mail()
'
'   Email all rows held in excel file where in Col E an email address exists. Then attach an excel file named in Column A.


'
    Dim r As Range
    Dim rLookin As Range
             
    With Application
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    End With
    
    With Worksheets("ESS_Mail")
    Set rLookin = .Range(.Cells(2, "E"), .Cells(.UsedRange.Rows.Count, "E"))
    End With
    
    For Each r In rLookin
       
                
        If Not r Is Nothing Then
        
         ' Now Email and attach excel file
        
         ESubject = "ESS Report"
         ESendto = r.Value
         EFilename = r.Offset(0, -4)
         
         Set App = CreateObject("Outlook.Application")
         Set Itm = App.CreateItem(0)
        
            With Itm
            .Subject = ESubject
            .To = ESendto
            ' Debug.Print EFilename
            '.CC = CCTo
            ' .Body = Ebody
            '.Attachments.Add "G:\Marketing\Management and admin\Monthly Management Reports\ESS & EIT Monthly Reporting\ & EFilename"
            '.Display ' This property is used when you want _
              the user to see email and manually send.
            '.Send
               
            End With
        
        Set App = Nothing
        Set Itm = Nothing
        
        End If
    Next

  With Application2
    Application.ScreenUpdating = True
    Application.EnableEvents = True
  End With

End Sub

I would appreciate any help to overcome these outstanding problems.

 

[MakeItSo]

1.)

If ESendTo Like "*@*.*" Then

2.) Watch your quotes!

Change

.Attachments.Add "G:\Marketing\Management and admin\Monthly Management Reports\ESS & EIT Monthly Reporting\ & EFilename"

to

.Attachments.Add "G:\Marketing\Management and admin\Monthly Management Reports\ESS & EIT Monthly[b] Reporting\" & EFilename[/b]

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[andycapp28]

Hi thanks for the Quote answer, my ESendto format was indeed *@*, example andycapp28@googlemail.com

but it returns the Undeliverable: ESS_Report

System Administrator

Your message did not reach some or all of the intended recipients.

Subject: ESS Report
Sent: 20/04/2010 09:34

The following recipient(s) could not be reached:

'mailto:andycapp28@googlemail.com' on 20/04/2010 09:34
The format of the e-mail address is incorrect. Check the address, look up the recipient in the Address Book, or contact the recipient directly to find out the correct address.

 

[PHV]

ESendto = Replace(r.Value, "mailto:", "")

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[andycapp28]

PHV,

Many thanks that's a great spot.

AC

 

[andycapp28]

Hi Can anyone resolve how in my code I can make the IF condition False and so ignore when the value in r is from an empty cell in column C.

Dim r As Range
    
    Dim rLookin As Range
             
    With Worksheets("ESS_Mail")
    Set rLookin = .Range(.Cells(2, "E"), .Cells(.UsedRange.Rows.Count, "E"))
    End With
    
    For Each r In rLookin
               
        If Not r Is Nothing Then
        
         ' Now Email and attach data file
        
         ESubject = "ESS Report"
         ESendto = r.Value
         EFilename = r.Offset(0, -4)
         
         Set App = CreateObject("Outlook.Application")
         Set Itm = App.CreateItem(0)
        
            With Itm
            .Subject = ESubject
            .To = ESendto
            .Attachments.Add "G:\Marketing\Management and admin\Monthly Management Reports\ESS_and_Monthly Reporting\" & EFilename

            .Send
               
            End With
        
        Set App = Nothing
        Set Itm = Nothing
        
        End If
    Next

End Sub

 

[SkipVought]

NOTHING means that the object has NOT been set to anything.

If Trim(r.Value) = "" Then

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[andycapp28]

Thanks Skip but I'm misleading you. I need to know how to code such that only when r value has a non blank Cell does it prepare an email.

Many thanks
AC

 

[SkipVought]

For Each r In rLookin

If Trim(r.Value) = "" Then
...

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

what I meant was

For Each r In rLookin

If Trim(r.Value) <> "" Then
...

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[andycapp28]

That's it, fantastic Skip yet again!

img

http://www.mysite.com/images/thumbsup.gif

AC