PDA

View Full Version : Emailing Named Ranges Using VBA



bloodmilksky
10-17-2016, 09:23 AM
Hi Guys,

I was just wondering if anyone can help me.

I have a sheet that has alot of named ranges and all of them have the customers AC number at the top of the first column and the email address in the 2nd column (a1:b1,C1:D1,E1:F1....and so on) they all vary in size for example A1:B20 C1:10 but all of the ranges names are the same as the AC Number

I was just wondering if anyone knows how to use VBA to run through Sheet2 and email of each of these named ranges to the email address at the top of the range.

I have asked this question previously but the answer that I was offered keeps erroring with:

Run-Time Error '-2147467259(80004005)':

Method 'MailEnvelope' of object '_worksheet' failed

and highlights this line in the code "With ActiveSheet.MailEnvelope"

Any help would be greatly appreciated.

many thanks

Jamie


Sub Email_Ranges()
Dim rG As Range
Dim RangeToSend As Range
Dim CustomerMail As String

Set rG = ActiveWorkbook.ActiveSheet.[b1]

ActiveWorkbook.EnvelopeVisible = True

Do While rG.Value <> vbNullString
CustomerMail = rG.Value
Set RangeToSend = rG.Offset(, -1).Resize(30, 2)

'With RangeToSend.Parent.MailEnvelope

''Uncomment below if you get an error
rG.Parent.Activate
RangeToSend.Select
With Selection.Parent.MailEnvelope

.Introduction = "Good Morning"
With .Item
.To = CustomerMail
.Subject = "Just testing, sorry for filling your inbox ^_^ "
.display 'to test
.Send 'to send
End With
End With
Debug.Print CustomerMail & " receives " & RangeToSend.Address
Set rG = rG.Offset(, 2)
Loop

ActiveWorkbook.EnvelopeVisible = False
End Sub
Sub Email_Ranges()
Dim rG As Range
Dim RangeToSend As Range
Dim CustomerMail As String

Set rG = ActiveWorkbook.ActiveSheet.[b1]

ActiveWorkbook.EnvelopeVisible = True

Do While rG.Value <> vbNullString
CustomerMail = rG.Value
Set RangeToSend = rG.Offset(, -1).Resize(30, 2)

'With RangeToSend.Parent.MailEnvelope

''Uncomment below if you get an error
rG.Parent.Activate
RangeToSend.Select
With Selection.Parent.MailEnvelope

.Introduction = "Good Morning"
With .Item
.To = CustomerMail
.Subject = "Just testing, sorry for filling your inbox ^_^ "
.display 'to test
.Send 'to send
End With
End With
Debug.Print CustomerMail & " receives " & RangeToSend.Address
Set rG = rG.Offset(, 2)
Loop

ActiveWorkbook.EnvelopeVisible = False
End Sub

Kenneth Hobs
10-17-2016, 10:55 AM
Why not just use Outllook? http://www.rondebruin.nl/win/s1/outlook/bmail3.htm

As Ron points out, there are times where MailEvenlope with fail. Ron also shows how to email the range as html.

Of course you could always make the range into a pdf file and attach it.

bloodmilksky
10-18-2016, 02:02 AM
is there a way that you could automate that translation of a range into a PDF File.

And thank you for coming back to me really appreciate your help.

Kenneth Hobs
10-18-2016, 04:50 AM
Sub Test_PublishToPDF()
Dim s As String, ss As String
s = Range("F5").Value2 & Range("F4").Value2 & ".pdf"
'ss= PublishToPDF(s, ActiveSheet) 'Use set print range

Dim r As Range
Set r = Columns("A:A").Find("TOTAL LIABILITIES & EQUITY")
If r Is Nothing Then Exit Sub
ss = PublishToPDF(s, Range("A1:B" & r.Row)) 'Use a dynamic range
'ss = PublishToPDF(s, Range("A1:B" & r.Row), True) 'Use a dynamic range, prompt for filename
Shell "cmd /c " & ss, vbNormalFocus
End Sub


Function PublishToPDF(fName As String, o As Object, _
Optional tfGetFilename As Boolean = False) As String
Dim rc As Variant
rc = fName
If tfGetFilename Then
rc = Application.GetSaveAsFilename(fName, "PDF (*.pdf), *.pdf", 1, "Publish to PDF")
If rc = "" Then Exit Function
End If

o.ExportAsFixedFormat Type:=xlTypePDF, fileName:=rc _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

PublishToPDF = rc
End Function

bloodmilksky
10-18-2016, 04:55 AM
would this run through the ranges trhat I have currently set up on my workbook and create these PDF's or would I need to do it range by range?

Kenneth Hobs
10-18-2016, 07:22 AM
You can use a loop to iterate range Areas. I will show you how when I can later today.

Kenneth Hobs
10-18-2016, 06:55 PM
This worked for me. Run from activesheet with range A1 to ...
Place code in a Module. Add Word object in Visual Basic Editor (VBE) menus Tools > References. Play Main().


Sub Main()
Dim r As Range, i As Long, c As Range
Dim fp As String, fn(1 To 1) As Variant

'File Path to save pdf's to.
fp = ThisWorkbook.Path & "\"
If Len(Dir(fp, vbDirectory)) = 0 Then
MsgBox fp & " does not exist.", vbCritical, "Macro Ending"
Exit Sub
End If

'Set range on current sheet and if odd columns, end.
Set r = Range("A1", Range("A1").End(xlToRight))
If (r.Cells.Count Mod 2) <> 0 Then
MsgBox "The top row's column count must be an even number.", _
vbCritical, "Macro Ending"
Exit Sub
End If

'Interate r and make pdf, and send emails with pdf
For i = 1 To r.Cells.Count Step 2
Set c = Range(r(i).Value)
If c Is Nothing Then GoTo NextI
fn(1) = fp & r(i).Value & ".pdf"
c.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fn, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
OMail r(i + 1).Value, r(i).Value & " Report", _
"Your report is attached.", fn
NextI:
Next i
End Sub






'More Excel to Outlook Examples: http://www.rondebruin.nl/win/s1/outlook/bmail4.htm
'Add reference: Microsoft Outlook xx.x Library, where xx.x is 14.0, 15.0, 16.0, etc.
Sub OMail(sTo As String, sSubject As String, sBody As String, _
Optional vAttachments, Optional bSend As Boolean = True)

Dim olApp As Outlook.Application, olMail As Outlook.MailItem, i As Integer
Set olApp = New Outlook.Application


Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = sTo
.Subject = sSubject
.Body = sBody

If Not IsEmpty(vAttachments) Then
For i = LBound(vAttachments) To UBound(vAttachments)
If Len(Dir(vAttachments(i))) <> 0 Then .Attachments.Add vAttachments(i)
Next i
End If

If bSend Then
.Send
Else
.Display
End If
End With

Set olMail = Nothing
Set olApp = Nothing
End Sub