give email id A1 box in sheet and run macro

---------------------------------------------------------------------------------------------------------------------------------------------------

Sub Mail_Every_Worksheet()

'Working in 2000-2010

    Dim sh As Worksheet

    Dim wb As Workbook

    Dim FileExtStr As String

    Dim FileFormatNum As Long

    Dim TempFilePath As String

    Dim TempFileName As String

    Dim OutApp As Object

    Dim OutMail As Object



    TempFilePath = Environ$("temp") & "\"



    If Val(Application.Version) < 12 Then

        'You use Excel 97-2003

        FileExtStr = ".xls": FileFormatNum = -4143

    Else

        'You use Excel 2007-2010

        FileExtStr = ".xlsx": FileFormatNum = 51

    End If



    With Application

        .ScreenUpdating = False

        .EnableEvents = False

    End With



    Set OutApp = CreateObject("Outlook.Application")



    For Each sh In ThisWorkbook.Worksheets

        If sh.Range("A1").Value Like "?*@?*.?*" Then



            sh.Copy

            Set wb = ActiveWorkbook



            TempFileName = " " & sh.Name & " of " _

                         & ThisWorkbook.Name





            Set OutMail = OutApp.CreateItem(0)

            With wb

                .SaveAs TempFilePath & TempFileName & FileExtStr, _

                        FileFormat:=FileFormatNum

                On Error Resume Next

                With OutMail

                    .To = sh.Range("A1").Value

                    .CC = ""

                    .BCC = ""

                    .Subject = "DAILY DASHBOARD"

                    .Body = "DAILY DASHBOARD"

                    .Attachments.Add wb.FullName

                    'You can add other files also like this

                    '.Attachments.Add ("C:\test.txt")

                    .Send   'or use .Display

                End With

                On Error GoTo 0

                .Close SaveChanges:=False

            End With

            Set OutMail = Nothing



            Kill TempFilePath & TempFileName & FileExtStr

        End If

    Next sh



    Set OutApp = Nothing



    With Application

        .ScreenUpdating = True

        .EnableEvents = True

    End With

End Sub











=============================================================================

On Thu, Mar 22, 2012 at 8:58 AM, NOORAIN ANSARI <noorain.ans...@gmail.com>wrote:

> Dear Raj,
>
> Please try through below link.
>
> http://www.gmailextractor.com/
>
> --
> Thanks & regards,
> Noorain Ansari
>  *http://noorainansari.com/*
> *http://excelmacroworld.blogspot.com/*<http://excelmacroworld.blogspot.com/>
>
>
> On Wed, Mar 21, 2012 at 11:56 PM, Raj Mahapatra <rajafs...@gmail.com>wrote:
>
>> hi group,
>>
>> can you please advice me how to extract email id's from gmail or outlook
>> using VBA
>>
>> Thanks & Regards
>>
>> --
>> FORUM RULES (986+ members already BANNED for violation)
>>
>> 1) Use concise, accurate thread titles. Poor thread titles, like Please
>> Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice
>> will not get quick attention or may not be answered.
>>
>> 2) Don't post a question in the thread of another member.
>>
>> 3) Don't post questions regarding breaking or bypassing any security
>> measure.
>>
>> 4) Acknowledge the responses you receive, good or bad.
>>
>> 5) Cross-promotion of, or links to, forums competitive to this forum in
>> signatures are prohibited.
>>
>> NOTE : Don't ever post personal or confidential data in a workbook. Forum
>> owners and members are not responsible for any loss.
>>
>>
>> ------------------------------------------------------------------------------------------------------
>> To post to this group, send email to excel-macros@googlegroups.com
>>
>
>
>
>
>  --
> FORUM RULES (986+ members already BANNED for violation)
>
> 1) Use concise, accurate thread titles. Poor thread titles, like Please
> Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice
> will not get quick attention or may not be answered.
>
> 2) Don't post a question in the thread of another member.
>
> 3) Don't post questions regarding breaking or bypassing any security
> measure.
>
> 4) Acknowledge the responses you receive, good or bad.
>
> 5) Cross-promotion of, or links to, forums competitive to this forum in
> signatures are prohibited.
>
> NOTE : Don't ever post personal or confidential data in a workbook. Forum
> owners and members are not responsible for any loss.
>
>
> ------------------------------------------------------------------------------------------------------
> To post to this group, send email to excel-macros@googlegroups.com
>

-- 
FORUM RULES (986+ members already BANNED for violation)

1) Use concise, accurate thread titles. Poor thread titles, like Please Help, 
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get 
quick attention or may not be answered.

2) Don't post a question in the thread of another member.

3) Don't post questions regarding breaking or bypassing any security measure.

4) Acknowledge the responses you receive, good or bad.

5)  Cross-promotion of, or links to, forums competitive to this forum in 
signatures are prohibited. 

NOTE  : Don't ever post personal or confidential data in a workbook. Forum 
owners and members are not responsible for any loss.

------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com

Reply via email to