Using VBA to send attachments with changing hyperlinks based on date

[georgefreight]

Hi
I've spent 2 days searching around forums to solve my problem and seem to be hitting a dead end, if anyone knows if this is possible or how to do it that's much appreciated.

I'm trying to send emails based on this link Mail a different file(s) to each person in a range
Col A is name, Col B is email and Col C is the filepath

I'm sending a monthly email that sends a different pdf to each customer each month
The filepath remains the same with eg C:\\folder\rates\ however the file names have a constant business name but have a changing date
ie c:\folder\rates\georges cars 21 09 2015.pdf

When I copy and paste this filepath in the macro works correctly, however when I've replaced column C with
=hyperlink(filepath & business name & "dd mm yyyy.pdf")
ie =HYPERLINK(E3&F3&" "&G3,"link name")
it allows me to click through the file however it won't add this file as an attachment when I run the macros to create the emails.


Is it possible to set up the hyperlink so it can updated with the date and still attach to the emails??

Not bothered if I have to enter the date manually as I didn't have much luck using it in the hyperlink with =today()

Many thanks
George

 

[jjlwork]

NOt 100% certain, but I believe your issue is spaces in the file name. Beyond my expertise to correct and give you the right answer but check here: Space in the Path of the Shell Function in VBA - Toolbox for IT Groups I believe this is similar to the problem you are having?

 

[georgefreight]

Thanks for the reply, I'll experiment with double quotes to remove the spaces.

The hyperlink I've created in the excel sheet does open the correct file when I click on it, its just the macro that doesn't recognise it and attach it.
I'll post an update if I succeed or not

 

[georgefreight]

Update: I haven't solved it but the work around I've used is to write out the filepath and then highlight the column and use replace all to update the date each month.
Its not pretty, but it works.

 

[John_w]

It seems silly to have to use a manual work around when the macro could handle the column C file paths when they are the result of HYPERLINK formulas, if I understand you correctly.

Try this modified version of Ron's code. File path hyperlinks are expected to be in column C only (not C:Z). The main change is the EvaluateHyperlinkLocation function which returns what the link_location parameter of the HYPERLINK function evaluates to.

'Modified version of http://www.rondebruin.nl/win/s1/outlook/amail6.htm
'which works when file path in column C rows is the result of a =HYPERLINK formula.

Sub Send_Files()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    Dim filePath As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

        'Enter the path/file names in the C column (only) in each row
        Set rng = sh.Cells(cell.Row, 1).Range("C1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .Subject = "Testfile"
                .Body = "Hi " & cell.Offset(0, -1).Value

                Set FileCell = cell.Offset(0, 1)
                filePath = EvaluateHyperlinkLocation(FileCell)
                If filePath <> "" Then
                    .Attachments.Add filePath
                End If
                
                .Send  'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub


Private Function EvaluateHyperlinkLocation(HyperlinkFunctionCell As Range) As String

    'Given a cell containing a HYPERLINK function, returns what the link_location parameter evaluates to
    
    Dim p1 As Long, p2 As Long

    EvaluateHyperlinkLocation = ""
    p1 = InStr(1, HyperlinkFunctionCell.Formula, "HYPERLINK(", vbTextCompare)
    If p1 > 0 Then
        p1 = p1 + Len("HYPERLINK(")
        p2 = InStr(p1, HyperlinkFunctionCell.Formula, ",")
        If p2 = 0 Then p2 = InStr(p1, HyperlinkFunctionCell.Formula, ")")  'optional friendly_name parameter not present
        EvaluateHyperlinkLocation = Evaluate(Mid(HyperlinkFunctionCell.Formula, p1, p2 - p1))
    End If
    
End Function

 

[georgefreight]

Thanks John. This gave me an error and I didn't have time to see what it was so in the end when for a simple solution of a fixed filepath

 

[georgefreight]

Hi John

Came into this issue again as other people need to use the spreadsheet not just myself.
Managed to make it work this time, thanks for all your help previously.