msgbox

Edje_007

New Member
Joined
Oct 18, 2006
Messages
9
Hi ,

I mail my worksheets with a push of a button , but I have one question :
I would like to get a warning ( msgbox) when there is no emailadres present in cell H16 !
Who can help me ? :rolleyes:

Thanks in advance !

Ed

Code:
Dim strDate As String
    Dim sh As Worksheet
 
      Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
    
    'Mail worksheet  TO  emailadres in cell h16
    
        If sh.Range("H16").Value Like "*@*" Then
            sh.Copy
            strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")

             'Name worksheet
            
            ActiveWorkbook.SaveAs " " & ThisWorkbook.Name _
                                & " " & strDate & ".xls"
                                
                      
                                
                             ActiveWorkbook.SendMail ActiveSheet.Range("H16").Value, _
                                    "test test "
            ActiveWorkbook.ChangeFileAccess xlReadOnly
            Kill ActiveWorkbook.FullName
            ActiveWorkbook.Close False
            
        End If
         
    Next sh
    Application.ScreenUpdating = True
    End Sub

EDIT: Added Code tags - Moderator
 

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

Andrew Fergus

MrExcel MVP
Joined
Sep 9, 2004
Messages
5,432
Hi Ed

Insert the following 2 lines of code immediately before the 'End If' line :

Else
MsgBox "Please enter an e-mail address in H16 on worksheet '" & sh.Name & "'", vbCritical, "Error"

HTH, Andrew
 

Edje_007

New Member
Joined
Oct 18, 2006
Messages
9
Hi Andrew ,

Thanks for the quick responce ! :biggrin:

It seems to works , but I get the Msgbox tree times on row ! :(

This is probably because of the tree worksheets I have in that workbook !
Can you tell me how to define the right worksheet ?


Thanks !!
 

Andrew Fergus

MrExcel MVP
Joined
Sep 9, 2004
Messages
5,432
Hi

The reason you are seeing 3 message boxes is because your existing code loops through each worksheet and tries to send a different e-mail for each worksheet. If you have three worksheets it is trying to send three different e-mails and if cell H16 is blank in each worksheet then you will get the three error messages. I presume that is not what you want?

Can you explain what you want? For example, do you want to send the entire spreadsheet in one e-mail? Or do you want to send each sheet in separate e-mails to the one address in cell H16 from the first sheet? Or do you just want to e-mail the first worksheet?

Andrew
 

Edje_007

New Member
Joined
Oct 18, 2006
Messages
9

ADVERTISEMENT

Hi Andrew,

I just want to mail one worksheet that I called " Invoice ".
From the other worksheets I take the data , and they don't need to be send !


Thx

Ed
 

Andrew Fergus

MrExcel MVP
Joined
Sep 9, 2004
Messages
5,432
Hi Ed

Try this code instead :
Code:
Public Sub MailMe()

Dim strDate As String, sh As Worksheet

Application.ScreenUpdating = False

Set sh = ThisWorkbook.Worksheets(1)

    If sh.Range("H16").Value Like "*@*" Then
        sh.Copy
        strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
        ActiveWorkbook.SaveAs " " & ThisWorkbook.Name & " " & strDate & ".xls"
        ActiveWorkbook.SendMail ActiveSheet.Range("H16").Value, "Insert subject here"
        ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill ActiveWorkbook.FullName
        ActiveWorkbook.Close False
    Else
        MsgBox "Please enter an e-mail address in cell H16", vbCritical, "Error"
    End If

Application.ScreenUpdating = True

Set sh = Nothing

End Sub
I used the sub name 'MailMe' - use your existing sub name instead.

If the invoice worksheet is not the first worksheet in the spreadsheet then change this part :
Set sh = ThisWorkbook.Worksheets(1)

to this:
Set sh = ThisWorkbook.Worksheets("Invoice")

HTH, Andrew
 

Watch MrExcel Video

Forum statistics

Threads
1,114,676
Messages
5,549,374
Members
410,911
Latest member
AniEx
Top