Excel VBA Macro to Send all selected draft email to sender one by one automatically from Outlook

Hi

Many of us have an application to create draft mailers to send it to customers to vendors after reviewing, in case it is few of tens then you can do it manually. How about it is tons or thousands ?

Opening draft email one by one & pressing send button is cumbersome.

Here you go a macro which is designed to work email stored in outlook draft folders. You need to select emails which you want to send & run macro. Macro will loop through emails one by one & sends it to user specified in to filed. If no one is specified to field email will be ignored.

Do let me know if you liked it or not, you can write your queries to ExcelVbaLab@googlegroup.com


Cheers!!

Download File

Macro of the day : Create dynamic Named Ranges using Macro

Hi All,

Working on dashboards & requires you to create defined name with huge data list, tired of creating names & updating it manually..

Here is simple solution using macro, what you need to do is..

1 - Enter data in main sheet to create defines names of your choice

2 - Macro will create unique names for each item in column B of sheet MainData;

3 - As soon as you type data in sheet MainData, names will get auto updated;

4 - To Delete all names & rebuilt name list click one of the above button;

For any query write back to us on ExcelVbaLab@googlegroups.com

Group URL

Give your valuable feedback.

Cheers!!

Click to Downloadfile

Use excel to search image on google and insert link of first image found

Hi,

Making project where you need to download tens of hundreds of images from web & tired of googling around..Here comes the solution using Excel VBA Macro.

In column A insert name of objects to be download & in Column B you will get URL of Image & in Column C you will get Image of the same size of your cell.

Click to Download


Source Code:

'Requires additional references to Microsoft Internet Control

'Requires additional HTML object library

Public Function URLDecode(url$) As String
    With CreateObject("ScriptControl")
        .Language = "JavaScript"
        URLDecode = .Eval("unescape(""" & url & """)")
    End With
End Function

Public Sub Fetch_Image()

Dim IE As InternetExplorer

Dim HTMLdoc As HTMLDocument

Dim imgElements As IHTMLElementCollection

Dim imgElement As HTMLImg

Dim aElement As HTMLAnchorElement

Dim n As Integer, i As Integer

Dim url As String, url2 As String, furl as string

Dim m, lastRow As Long

  

lastRow = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lastRow

    url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&source=lnms&tbm=isch&sa=X&rnd=1"

    Set IE = New InternetExplorer

  
    With IE

    .Visible = False

    .navigate url

  
    Do Until .readyState = 4: DoEvents: Loop

    'Do Until IE.document.readyState = "complete": DoEvents: Loop

    Set HTMLdoc = .document

    Set imgElements = HTMLdoc.getElementsByTagName("IMG")

  
    n = 1

    For Each imgElement In imgElements

        If InStr(imgElement.src, sImageSearchString) Then

            If imgElement.ParentNode.nodeName = "A" Then

                Set aElement = imgElement.ParentNode

              

                If n = 2 Then

                url2 = aElement.href

                url3 = imgElement.src

                GoTo done:

                End If

                n = n + 1

                End If

        End If

    Next

done:

furl = InStrRev(url2, "&imgrefurl=", -1)

furl = Mid(url2, 40, furl - 40)

furl = URLDecode(furl)


    Cells(i, 2) = furl

    Set m = ActiveSheet.Pictures.Insert(furl)

    With Cells(i, 3)

    t = .Top

    l = .Left

    w = .Width

    h = .Height

    End With

    With m

    .Top = t

    .Left = l

    .ShapeRange.Width = w

    .ShapeRange.Height = h

    End With

  

IE.Quit

Set IE = Nothing

    End With

Next



MsgBox "Done!!"

End Sub

Cheers!!