Automatic E-mail - Use of hyperlink in cell to add attachment

[RichTea88]

Good Day Lads & Ladettes!

Tried to solve this in another thread but it wasn't going anywhere.

Below is my sub to send an automatic e-mail depending on the date in a Cell. Each row contains metadata about a file (a transmittal - PDF), and in column 'A' of that row it has a file number 'ENER-P12345-0413-001' which is also a hyperlink to the file in question. I'd like to use the hyperlink address stored in this cell to attach the file to them generated e-mail automatically. Does anyone know if this is possible? Or how to reference the hyperlink address stored within this cell?

Many thanks to anyone who can solve this one - I figure the data must be stored in the cell somewhere so it should be possible, but I'm no whiz kid like you macroids out there!

Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim DocT As String
    Dim LastRow As Long, NextRow As Long, RowNo As Long
    Dim wsEmail As Worksheet
    Dim Attach As String
    Set wsEmail = ThisWorkbook.Sheets("Transmittal Register")

    
    
    With wsEmail
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For RowNo = 2 To LastRow
            'Change "Date + 1" to suit your timescale
            If .Cells(RowNo, "L") = "" And .Cells(RowNo, "I") <= Date + 1 Then
        Email = .Cells(RowNo, "F")
                DocT = .Cells(RowNo, "D")
                Subj = "Automated E-mail - Document Due " & .Cells(RowNo, "I")
                Attach = .Cells(RowNo, "A")
                Msg = ""

                Msg = "Good Day " & "," & vbCrLf & vbCrLf _
                        & "This is an automated e-mail to let you know that document" & vbCrLf _
                        & .Cells(RowNo, "C") & " - " & DocT & vbCrLf _
                        & "That was issued for " & .Cells(RowNo, "G") & " is due on " & .Cells(RowNo, "I") & "." & vbCrLf & vbCrLf _
                        & "Many Thanks, " & vbCrLf & vbCrLf & "AutoMech"
                
                'Replace spaces with %20 (hex)
                Subj = Replace(Subj, " ", "%20")
                Msg = Replace(Msg, " ", "%20")
                
                'Replace carriage returns with %0D%0A (hex)
                Msg = Replace(Msg, vbCrLf, "%0D%0A")
                
                'Create the URL
                URL = "mailto:" & Email & "?subject=" & Subj & "&Attachments=" & Attach & "&body=" & Msg
                
                'Execute the URL (start the email client)
                ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
                
                'Return Flag

               
                .Cells(RowNo, "L") = "X"
            End If
        Next
    End With
End Sub

[abousetta]

Short answer... no you can't...

You are using Shell Execute to send the email and this method can't handle attachments. This thread explains the problem and some solutions using CDO.

You can also use Outlook (if you want)

Early binding:
Dim OutApp As Outlook.Application 
Dim OutMail As Outlook.MailItem
  On Error Resume Next
  Set OutApp = GetObject("Outlook.Application")
    On Error GoTo 0
    If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
    Do: Loop Until Not OutApp Is Nothing
  Set OutMail = OutApp.CreateItem(0) 
    With OutMail 
         .To = ""
         .CC = ""
         .BCC = ""
         .Recipients.Add ""
         .SentOnBehalfOfName = "" 
         .Subject = ""
         .ReadReceiptRequested = False
         .Body = ""
         .Attachments.Add ""
         .Send
         .Display
         .Show
      End With 
  Set OutApp = Nothing 
  Set OutMail = Nothing

Late binding:

Dim OutApp As Object 
Dim OutMail As Object
  On Error Resume Next
  Set OutApp = GetObject("Outlook.Application")
    On Error GoTo 0
    If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
    Do: Loop Until Not OutApp Is Nothing
  Set OutMail = OutApp.CreateItem(0) 
    With OutMail 
         .To = ""
         .CC = ""
         .BCC = ""
         .Recipients.Add ""
         .SentOnBehalfOfName = "" 
         .Subject = ""
         .ReadReceiptRequested = False
         .Body = ""
         .Attachments.Add ""
         .Send
         .Display
         .Show
      End With 
  Set OutApp = Nothing 
  Set OutMail = Nothing

In the rare case you wanted to know every possible thing to do with Outlook, here are the enumerations:

' / Outlook Enumerated Constants /----------------------------------------
Public Enum OlActionCopyLike
olReply = 0 
olReplyAll = 1
olForward = 2
olReplyFolder = 3
olRespond = 4
End Enum

Public Enum OlActionReplyStyle
olOmitOriginalText = 0
olEmbedOriginalItem = 1
olIncludeOriginalText = 2
olIndentOriginalText = 3
olLinkOriginalItem = 4
olUserPreference = 5
olReplyTickOriginalText = 1000
End Enum

Public Enum OlActionResponseStyle
olOpen = 0
olSend = 1
olPrompt = 2
End Enum

Public Enum OlActionShowOn
olDontShow = 0
olMenu = 1
olMenuAndToolbar = 2
End Enum

Public Enum OlAttachmentType
olByValue = 1
olByReference = 4
olEmbeddeditem = 5
olOLE = 6
End Enum

Public Enum OlBodyFormat
olFormatUnspecified = 0
olFormatPlain = 1
olFormatHTML = 2
olFormatRichText = 3
End Enum

Public Enum OlBusyStatus
olFree = 0
olTentative = 1
olBusy = 2
olOutOfOffice = 3
End Enum

Public Enum OlConnectionMode 
olOffline = 100
olLowBandwidth = 200
olOnline = 300
End Enum

Public Enum OlDaysOfWeek
olSunday = 1
olMonday = 2
olTuesday = 4
olWednesday = 8
olThursday = 16
olFriday = 32
olSaturday = 64
End Enum

Public Enum OlDefaultFolders
olFolderDeletedItems = 3
olFolderOutbox = 4
olFolderSentMail = 5
olFolderInbox = 6
olFolderCalendar = 9
olFolderContacts = 10
olFolderJournal = 11
olFolderNotes = 12
olFolderTasks = 13
olFolderDrafts = 16
olPublicFoldersAllPublicFolders = 18
olFolderConflicts = 19
olFolderSyncIssues = 20
olFolderLocalFailures = 21
olFolderServerFailures = 22
olFolderJunk = 23
End Enum

Public Enum OlDisplayType
olUser = 0
olDistList = 1
olForum = 2
olAgent = 3
olOrganization = 4
olPrivateDistList = 5
olRemoteUser = 6
End Enum

Public Enum OlDownloadState
olHeaderOnly = 0
olFullItem = 1
End Enum

Public Enum OlEditorType
olEditorText = 1
olEditorHTML = 2
olEditorRTF = 3
olEditorWord = 4
End Enum

Public Enum OlExchangeConnectionMode
olNoExchange = 0
olOffline = 100
olCachedOffline = 200
olDisconnected = 300
olCachedDisconnected = 400
olCachedConnectedHeaders = 500
olCachedConnectedDrizzle 600
olCachedConnectedFull = 700
olOnline = 800
End Enum

Public Enum OlFlagIcon
olNoFlagIcon
olPurpleFlagIcon
olOrangeFlagIcon
olGreenFlagIcon
olYellowFlagIcon
olBlueFlagIcon
olRedFlagIcon
End Enum

Public Enum OlFlagStatus
olNoFlag = 0
olFlagComplete = 1
olFlagMarked = 2
End Enum

Public Enum OlFolderDisplayMode
olFolderDisplayNormal = 0
olFolderDisplayFolderOnly = 1
olFolderDisplayNoNavigation = 2
End Enum

Public Enum OlFormRegistry
olDefaultRegistry = 0
olPersonalRegistry = 2
olFolderRegistry = 3
olOrganizationRegistry = 4
End Enum

Public Enum OlGender
olUnspecified = 0
olFemale = 1
olMale = 2
End Enum

Public Enum OlImportance
olImportanceLow = 0
olImportanceNormal = 1
olImportanceHigh = 2
End Enum

Public Enum OlInspectorClose
olSave = 0
olDiscard = 1
olPromptForSave = 2
End Enum

Public Enum OlItemType
olMailItem = 0
olAppointmentItem = 1
olContactItem = 2
olTaskItem = 3
olJournalItem = 4
olNoteItem = 5
olPostItem = 6
olDistributionListItem = 7
End Enum

Public Enum OlJournalRecipientType
olAssociatedContact = 1
End Enum


Public Enum OlMailingAddress
olNone = 0
olHome = 1
olBusiness = 2
olOther = 3
End Enum

Public Enum OlMailRecipientType
olOriginator = 0
olTo = 1
olCC = 2
olBCC = 3
End Enum

Public Enum OlMeetingRecipientType
olOrganizer = 0
olRequired = 1
olOptional = 2
olResource = 3
End Enum

Public Enum OlMeetingResponse
olMeetingTentative = 2
olMeetingAccepted = 3
olMeetingDeclined = 4
End Enum

Public Enum OlMeetingStatus
olNonMeeting = 0
olMeeting = 1
olMeetingReceived = 3
olMeetingCanceled = 5
End Enum

Public Enum OlNetMeetingType
olNetMeeting = 0
olNetShow = 1
olExchangeConferencing = 2
End Enum

Public Enum OlNoteColor
olBlue = 0
olGreen = 1
olPink = 2
olYellow = 3
olWhite = 4
End Enum

Public Enum OlObjectClass
olApplication = 0
olNamespace = 1
olFolder = 2
olRecipient = 4
olAttachment = 5
olAddressList = 7
olAddressEntry = 8
olFolders = 15
olItems = 16
olRecipients = 17
olAttachments = 18
olAddressLists = 20
olAddressEntries = 21
olAppointment = 26
olRecurrencePattern = 28
olExceptions = 29
olException = 30
olAction = 32
olActions = 33
olExplorer = 34
olInspector = 35
olPages = 36
olFormDescription = 37
olUserProperties = 38
olUserProperty = 39
olContact = 40
olDocument = 41
olJournal = 42
olMail = 43
olNote = 44
olPost = 45
olReport = 46
olRemote = 47
olTask = 48
olTaskRequest = 49
olTaskRequestUpdate = 50
olTaskRequestAccept = 51
olTaskRequestDecline = 52
olMeetingRequest = 53
olMeetingCancellation = 54
olMeetingResponseNegative = 55
olMeetingResponsePositive = 56
olMeetingResponseTentative = 57
olExplorers = 60
olInspectors = 61
olPanes = 62
olOutlookBarPane = 63
olOutlookBarStorage = 64
olOutlookBarGroups = 65
olOutlookBarGroup = 66
olOutlookBarShortcuts = 67
olOutlookBarShortcut = 68
olDistributionList = 69
olPropertyPageSite = 70
olPropertyPages = 71
olSyncObject = 72
olSyncObjects = 73
olSelection = 74
olLink = 75
olLinks = 76
olSearch = 77
olResults = 78
olViews = 79
olView = 80
olItemProperties = 98
olItemProperty = 99
olReminders = 100
olReminder = 101
olConflict = 117
olConflicts = 118
End Enum

Public Enum OlOfficeDocItemsType
olExcelWorkSheetItem = 8
olWordDocumentItem = 9
olPowerPointShowItem = 10
End Enum

Public Enum OlOutlookBarViewType
olLargeIcon = 0
olSmallIcon = 1
End Enum


Public Enum OlPane
olOutlookBar = 1
olFolderList = 2
olPreview = 3
olNavigationPane = 4
End Enum

Public Enum OlPermission
olUnrestricted = 0
olDoNotForward = 1
olPermissionTemplate = 2
End Enum

Public Enum OlPermissionService
olUnknown = 0
olWindows = 1
olPassport = 2
End Enum


Public Enum OlRecurrenceState
olApptNotRecurring = 0
olApptMaster = 1
olApptOccurrence = 2
olApptException = 3
End Enum

Public Enum OlRecurrenceType
olRecursDaily = 0
olRecursWeekly = 1
olRecursMonthly = 2
olRecursMonthNth = 3
olRecursYearly = 5
olRecursYearNth = 6
End Enum

Public Enum OlRemoteStatus
olRemoteStatusNone = 0
olUnMarked = 1
olMarkedForDownload = 2
olMarkedForCopy = 3
olMarkedForDelete = 4
End Enum

Public Enum OlResponseStatus
olResponseNone = 0
olResponseOrganized = 1
olResponseTentative = 2
olResponseAccepted = 3
olResponseDeclined = 4
olResponseNotResponded = 5
End Enum

Public Enum OlSaveAsType
olTXT = 0
olRTF = 1
olTemplate = 2
olMSG = 3
olDoc = 4
olHTML = 5
olVCard = 6
olVCal = 7
olICal = 8
olMSGUnicode = 9
End Enum

Public Enum OlSensitivity
olNormal = 0
olPersonal = 1
olPrivate = 2
olConfidential = 3
End Enum

Public Enum OlShowItemCount
olNoItemCount = 0
olShowUnreadItemCount = 1
olShowTotalItemCount = 2
End Enum

Public Enum OlSortOrder
olSortNone = 0
olAscending = 1
olDescending = 2
End Enum

Public Enum OlStoreType
olStoreDefault = 1
olStoreUnicode = 2
olStoreANSI = 3
End Enum

Public Enum OlSyncState
olSyncStopped = 0
olSyncStarted = 1
End Enum

Public Enum OlTaskDelegationState
olTaskNotDelegated = 0
olTaskDelegationUnknown = 1
olTaskDelegationAccepted = 2
olTaskDelegationDeclined = 3
End Enum

Public Enum OlTaskOwnership
olNewTask = 0
olDelegatedTask = 1
olOwnTask = 2
End Enum

Public Enum OlTaskRecipientType
olUpdate = 2
olFinalStatus = 3
End Enum

Public Enum OlTaskResponse
olTaskSimple = 0
olTaskAssign = 1
olTaskAccept = 2
olTaskDecline = 3
End Enum

Public Enum OlTaskStatus
olTaskNotStarted = 0
olTaskInProgress = 1
olTaskComplete = 2
olTaskWaiting = 3
olTaskDeferred = 4
End Enum

Public Enum OlTrackingStatus
olTrackingNone = 0
olTrackingDelivered = 1
olTrackingNotDelivered = 2
olTrackingNotRead = 3
olTrackingRecallFailure = 4
olTrackingRecallSuccess = 5
olTrackingRead = 6
olTrackingReplied = 7
End Enum

Public Enum OlUserPropertyType
olOutlookInternal = 0
olText = 1
olNumber = 3
olDateTime = 5
olYesNo = 6
olDuration = 7
olKeywords = 11
olPercent = 12
olCurrency = 14
olFormula = 18
olCombination = 19
End Enum

Public Enum OlViewSaveOption
olViewSaveOptionThisFolderEveryone = 0
olViewSaveOptionThisFolderOnlyMe = 1
olViewSaveOptionAllFoldersOfType = 2
End Enum

Public Enum OlViewType
olTableView = 0
olCardView = 1
olCalendarView = 2
olIconView = 3
olTimelineView = 4
End Enum

Public Enum OlWindowState
olMaximized = 0
olMinimized = 1
olNormalWindow = 2
End Enum

abousetta

[RichTea88]

Hey,

Thanks for the info!

I can change the way I launch the e-mail, it'll take a bit of fiddling around but that can be done.

Would you know if it would be possible to use the hyperlink address in the cell as the information for the attachment in the above method?

[RichTea88]

I'm going to post this here - This guy seems to be doing a similar thing, any way we could use this and apply it to the application I'm doing?

http://stackoverflow.com/questions/5...-in-excel-cell

[abousetta]

Do you mean something like this http://blog.contextures.com/archives...cel-hyperlink/

abousetta

[RichTea88]

Yeah, I mean something like that Thanks.

I'm kind of rubbish at putting it in context though, and I'm having trouble changing the macro from a shell execute to the early or late binding like you had in your post. This is the problem with trying to create complex macros with no visual basic knowledge.
As soon as it gets to the .To = part I get an error.
If I post what code I have can you help me correct it please?

[abousetta]

I haven't tried using a hyperlink before but the concept should be the same (or maybe not... gota test and see what happens). If you need to download first to the local computer then you can use the code provided here. You can then automate the process... download to computer, attach to email, send, delete file from computer.

abousetta

P.S. haven't looked yet at the other thread

[RichTea88]

Okay,

Well I managed to change the execution of the e-mail with the late binding example you gave.

This seems to be working fine, now all I have to do is work out how to exctract the hyperlink address from the cell and use that for the attachment path! Exciting

Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim DocT As String
    Dim LastRow As Long, NextRow As Long, RowNo As Long
    Dim wsEmail As Worksheet
    Dim Attach As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    Set wsEmail = ThisWorkbook.Sheets("Transmittal Register")
    
    With wsEmail
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For RowNo = 2 To LastRow
            'Change "Date + 1" to suit your timescale
            
            If .Cells(RowNo, "L") = "" And .Cells(RowNo, "I") <= Date + 1 Then
                
                On Error Resume Next
                Set OutApp = GetObject("Outlook.Application")
                    On Error GoTo 0
                    If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
                    Do: Loop Until Not OutApp Is Nothing
                Set OutMail = OutApp.CreateItem(0)
                
                With OutMail
                    Email = wsEmail.Cells(RowNo, "F")
                    DocT = wsEmail.Cells(RowNo, "D")
                    Subj = "Automated E-mail - Document Due " & wsEmail.Cells(RowNo, "I")
            
                    Msg = ""

                    Msg = "Good Day " & "," & vbCrLf & vbCrLf _
                        & "This is an automated e-mail to let you know that document" & vbCrLf _
                        & wsEmail.Cells(RowNo, "C") & " - " & DocT & vbCrLf _
                        & "That was issued for " & wsEmail.Cells(RowNo, "G") & " is due on " & wsEmail.Cells(RowNo, "I") & "." & vbCrLf & vbCrLf _
                        & "Many Thanks, " & vbCrLf & vbCrLf & "AutoMech"
                        
                    .To = Email
                    .CC = ""
                    .SentOnBehalfOfName = "PPU Document Control"
                    .Subject = Subj
                    .Attachments.Add "Insert code to extract hyperlink from cell here"
                    .ReadReceiptRequested = False
                    .Body = Msg
                    .Display
                End With
         Set OutApp = Nothing
         Set OutMail = Nothing
        

               
                .Cells(RowNo, "L") = "X"
        End If
        Next
    End With
End Sub

[abousetta]

Maybe try:

.Attachments.Add rng.Hyperlinks(1).Address

with rng being the range in the excel sheet. I won't be able to test till tonight though.

abousetta

[abousetta]

Hi,

OK, I tested it with both a link to file on my local computer and a second link to a file on the internet. Both worked just fine so you should be good to go. Only thing I should mentioned is that you have to give time to download the file from the internet if that is where your files are stored.

abousetta

[RichTea88]

Hi Absouetta, Thanks for that!

I can't seem to get this working though. If I post my code with your bit included could tell me where I'm going wrong?

Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim DocT As String
    Dim LastRow As Long, NextRow As Long, RowNo As Long
    Dim wsEmail As Worksheet
    Dim Attach As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Set wsEmail = ThisWorkbook.Sheets("Transmittal Register")
    
    With wsEmail
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For RowNo = 2 To LastRow
            'Change "Date + 1" to suit your timescale
            
            If .Cells(RowNo, "L") = "" And .Cells(RowNo, "I") <= Date + 1 Then
                
                On Error Resume Next
                Set OutApp = GetObject("Outlook.Application")
                    On Error GoTo 0
                    If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
                    Do: Loop Until Not OutApp Is Nothing
                Set OutMail = OutApp.CreateItem(0)
                
                With OutMail
                    Email = wsEmail.Cells(RowNo, "F")
                    DocT = wsEmail.Cells(RowNo, "D")
                    Subj = "Automated E-mail - Document Due " & wsEmail.Cells(RowNo, "I")
                    Msg = ""
                    rng = wsEmail.Cells(RowNo, "A")
                    Msg = "Good Day " & "," & vbCrLf & vbCrLf _
                        & "This is an automated e-mail to let you know that document" & vbCrLf _
                        & wsEmail.Cells(RowNo, "C") & " - " & DocT & vbCrLf _
                        & "That was issued for " & wsEmail.Cells(RowNo, "G") & " is due on " & wsEmail.Cells(RowNo, "I") & "." & vbCrLf & vbCrLf _
                        & "Many Thanks, " & vbCrLf & vbCrLf & "AutoMech"
                        
                    .To = Email
                    .CC = ""
                    .SentOnBehalfOfName = "PPU Document Control"
                    .Subject = Subj
                    .Attachments.Add = rng.Hyperlinks(1).Address
                    .ReadReceiptRequested = False
                    .Body = Msg
                    .Display
                End With
         Set OutApp = Nothing
         Set OutMail = Nothing
        
                .Cells(RowNo, "L") = "X"
        End If
        Next
    End With
End Sub

Also the files will be in a folder on my computer so it should be fine speedwise. Thanks for the consideration though! And many thanks in advance guy, really appreciate it!

[abousetta]

A range must be set:

Set rng = wsEmail.Cells(RowNo, "A")

Works for me now.

abousetta

[RichTea88]

Still not working, even with the range set.

So confused...

Getting this runtime error - -2147352567(80020009)

Maybe the link to my file is too long?

[abousetta]

Which line is causing the problem? Maybe try using a file on a local drive with a shorter URL and walking through the code.

abousetta

[RichTea88]

It's this line

.Attachments.Add = rng.Hyperlinks(1).Address

I'm using a file on the desktop with a short url now, still getting the same problem. I've even tried using the get hyperlink as a function instead,but it just causes the same error. Maybe you have a reference library in use that I don't? Could you possibly paste the entire subroutine your using and I can try just replacing my one with it?

[RichTea88]

Whats really annoying is that when I hover over the

rng.Hyperlinks(1).Address

it shows the correct file path to the pdf. It just comes up with that error and I don't know what to do to get past it.

[RichTea88]

This is actually driving me crazy. It just doesn't seem like the coding is wrong

[RichTea88]

Change this from late binding to early binding. It still doesnt work, but it's went from being a runtime error to a compile error - 'Argument not optional' and it highlights this part '.Add ='

If I remove the attachments line of code it works fine, so there's something wrong with this one line. I'll give rep to anyone who gives me any insight into why this isn't working, even if they're wrong because I'm out of ideas and I'd hate for a single line of coding to stop me solving this

[RichTea88]

Solved!

and yet not solved

This is the corrected code

.Attachments.Add (rng.Hyperlinks(1).Address)

The problem - the workbook is in the same main folder as the files, but in different subfolders (if you get what I mean). Because excel shortens the hyperlink it means it won't work as an attachment. Is there anyway to have the hyperlinks as the full address?

This code seems to work when the workbook is on my desktop and the hyperlink to the file is on a different drive.

[RichTea88]

Solved! Code below.

Not exactly the neatest way around it but it works! Pretty much had to set a constant for the address of the folder the files & workbook are kept in(FPath), then used the grab hyperlink (FName) to get the futher extension of folders and combined them to make another variable (Ease).

As I said, not exactly the neatest way, but it works! Can I give Rep to myself? :P

Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim DocT As String
    Dim LastRow As Long, NextRow As Long, RowNo As Long
    Dim wsEmail As Worksheet
    Dim Attach As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim FPath As String
    Dim Ease As String
    Dim FName As String

    Set wsEmail = ThisWorkbook.Sheets("Transmittal Register")
    
    With wsEmail
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For RowNo = 2 To LastRow
            'Change "Date + 1" to suit your timescale
            
            If .Cells(RowNo, "L") = "" And .Cells(RowNo, "I") <= Date + 1 Then
                
                On Error Resume Next
                Set OutApp = GetObject("Outlook.Application")
                    On Error GoTo 0
                    If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
                    Do: Loop Until Not OutApp Is Nothing
                Set OutMail = OutApp.CreateItem(0)
                Set rng = wsEmail.Cells(RowNo, "A")
                FPath = "\\em-abz-fps-01\share\PPU\Operations\Project Folders\Client\P12345 - Field Suspension Works\Client Communications\"
                FName = rng.Hyperlinks(1).Address
                Ease = FPath & FName
                With OutMail
                    Email = wsEmail.Cells(RowNo, "F")
                    DocT = wsEmail.Cells(RowNo, "D")
                    Subj = "Automated E-mail - Document Due " & wsEmail.Cells(RowNo, "I")
                    Msg = ""
                    
                    Msg = "Good Day " & "," & vbCrLf & vbCrLf _
                        & "This is an automated e-mail to let you know that document" & vbCrLf _
                        & wsEmail.Cells(RowNo, "C") & " - " & DocT & vbCrLf _
                        & "That was issued for " & wsEmail.Cells(RowNo, "G") & " is due on " & wsEmail.Cells(RowNo, "I") & "." & vbCrLf & vbCrLf _
                        & "Many Thanks, " & vbCrLf & vbCrLf & "AutoMech"
                        
                    .To = Email
                    .CC = ""
                    .SentOnBehalfOfName = "PPU Document Control"
                    .Subject = Subj
                    .ReadReceiptRequested = False
                    .Body = Msg
                    .Attachments.Add (Ease)
                    .Display

                End With
            Set OutApp = Nothing
            Set OutMail = Nothing
            Set rng = Nothing
            .Cells(RowNo, "L") = "X"
        End If
        Next
    End With
End Sub

A Big thanks to Abousetta for all his help! Cheers Dude!

[abousetta]

Glad it worked out.

abousetta