this has been doing my head in. sorry if i explain this in over simplistic terms, its the only way my head will do it at the mo.
i have a spreadsheet that has a hyperlink to a file in column 'E', the hyperlink is displayed as the file type, ie PDF, DWG, DOC etc. when the hyperlink is clicked, it opens the document.
what i want to do is have a button that when clicked attaches the files to an email.
and a variation where it saves them to a folder of the users choice, which i beleive will be simplier.
at the mo the files are selected by putting a X in column 'G'.
i know that excel will not be able to get the full file path from the hyperlink, so for now (i hope to incoporate this in to the VBAing) in column 'I' i have the following function. this returns the hyperlink as plain text.
Function HyperLinkText(pRange As Range) As String
Dim ST1 As String
Dim ST2 As String
Dim LPath As String
Dim ST1Local As String
If pRange.Hyperlinks.Count = 0 Then
Exit Function
End If
LPath = ThisWorkbook.FullName
ST1 = pRange.Hyperlinks(1).Address
ST2 = pRange.Hyperlinks(1).SubAddress
If Mid(ST1, 1, 15) = "..\..\..\..\..\" Then
ST1Local = ReturnPath(LPath, 5) & Mid(ST1, 15)
ElseIf Mid(ST1, 1, 12) = "..\..\..\..\" Then
ST1Local = ReturnPath(LPath, 4) & Mid(ST1, 12)
ElseIf Mid(ST1, 1, 9) = "..\..\..\" Then
ST1Local = ReturnPath(LPath, 3) & Mid(ST1, 9)
ElseIf Mid(ST1, 1, 6) = "..\..\" Then
ST1Local = ReturnPath(LPath, 2) & Mid(ST1, 6)
ElseIf Mid(ST1, 1, 3) = "..\" Then
ST1Local = ReturnPath(LPath, 1) & Mid(ST1, 3)
Else
ST1Local = ST1
End If
If ST2 <> "" Then
ST1Local = "[" & ST1Local & "]" & ST2
End If
HyperLinkText = ST1Local
End Function
This code creates the email and adds the 2 attachments listed. my original approach was to have the code copy all the selected files to a temp folder, then the email part copy *.* as an attachment. but it seems it doesnt like wild cards being used to select files to attach, so it needs to return an absolute filepath and filename including extension. having the 2 files was a test to see if it would allow 2 seperate add commands and add the 2 files, and it does. so i was hoping to use the output of the function to return an absolute file path for the attachment then keep looping for all as marked in column 'G'
Sub Copy_to_Email()
'Declare your variables
Dim olApp As Object
Dim OLMail As Object
Dim Attach As String
Dim AllFiles As String
'Open Outlook start a new mail item
Set olApp = CreateObject("Outlook.Application")
Set OMail = olApp.CreateItem(0)
olApp.Session.Logon
'Build your mail item and send
With OMail
.Display
End With
signature = OMail.body
With OMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
Attach = "C:\Temp\excel"
.attachments.Add (Attach & "\test.xls")
Attach = "C:\Temp\excel"
.attachments.Add (Attach & "\New-components-brochure.pdf")
'.Attachments.Add = Dir(Attach & AllFiles)
'.HTMLBody =
End With
'Memory cleanup
Set OLMail = Nothing
Set olApp = Nothing
End Sub
please help.
Bookmarks