Thread
:
Using filename hyperlinks in Macros
View Single Post
#
4
Posted to microsoft.public.excel.programming
Ken
external usenet poster
Posts: 207
Using filename hyperlinks in Macros
Marlene
The following code works fine for me and accomplishes something similar
to what I think you are trying to do. I don't know use Word much, so I
am not familiar with inserting the contents of the file into the body
of the e-mail; but, as far as attaching a file based on a cell value,
this is a slightly trimmed down version of something I use;
Sub test()
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Set objOL = New Outlook.Application
For i = 1 To Range("datarange").Rows.Count
Set objMail = objOL.CreateItem(olMailItem)
addee = Range("datarange").Cells(i, 1)
att = CStr(Range("datarange").Cells(i, 2).Text)
subj = Range("datarange").Cells(i, 3)
Text = Range("datarange").Cells(i, 4)
intro = Range("datarange").Cells(i, 5)
CopyTo = Range("datarange").Cells(i, 6)
With objMail
.To = addee
.cc = CopyTo
.Subject = subj
.body = intro
.Attachments.Add att
.Display
.Send
End With
MsgBox "sent # " & i
Set objMail = Nothing
Set objOL = Nothing
Next i
End Sub
I have a defined range from which I grab my data as I prefer that to
the loop method you use, but that should not matter. The file is
attached fine regardless of whether the cell in the second column of
the datarange is a string with a file name, a hyper link to a valid
file, or a formula that evaluates to a valid file.
Good luck.
Ken
Norfolk, Va
wrote:
Hi Ken,
To begin, THANK YOU!
In Excel I have:
Column A: The to: email address
Column B: subject
Columb C: The text that goes into the email, it is linked to a file
(this file is the same every week)
Column D: the attachment- the one I'm having issues with
Column E: The introduction line
Column F: The cc email addresses
Here is the code:
Sub newtest()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim olMyApp As Outlook.Application
Dim olMyEmail As Outlook.mailItem
Dim wd As Word.Application
Dim doc As Word.Document
Dim itm As Object
Dim ID As String
Dim body As String
Dim blnWeOpenedWord As Boolean
'On Error Resume Next
'Initialize Word
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
blnWeOpenedWord = True
End If
'Initialize Workbook
Set wkb = ThisWorkbook
Set wks = wkb.Worksheets("Sheet1")
Set rng = wks.Range("A2")
'Initialize Outlook
Set olMyApp = New Outlook.Application
Set olMyEmail = olMyApp.CreateItem(olMailItem)
'Start Range at Cell A2
Range("A2").Select
'Loop through all rows in spreadsheet
Do Until IsEmpty(ActiveCell)
Set doc = wd.Documents.Open(CStr(ActiveCell.Offset(0,
2).Hyperlinks.Item(1).Address))
'Dim mailItm As Outlook.mailItem
'Set mailItm = Outlook.olMailItem
'mailItm.Attachments.add(
Set itm = doc.MailEnvelope.Item
doc.MailEnvelope.Introduction = ActiveCell.Offset(0, 4).Text
With itm
.To = ActiveCell.Text
.CC = ActiveCell.Offset(0, 5).Text
.Subject = ActiveCell.Offset(0, 1).Text
.Attachments.add (CStr(ActiveCell.Offset(0,
3).Hyperlinks.Item(1).Address))
.Save
End With
Set itm = Nothing
'Set itm = Application.Session.GetItemFromID(ID)
'itm.Send
doc.Close wdDoNotSaveChanges
If blnWeOpenedWord Then
wd.Quit
End If
'Open new email for each row
'Set olMyApp = New Outlook.Application
'Set olMyEmail = olMyApp.CreateItem(olMailItem)
'Column A has details of who to send the email to
'olMyEmail.To = ActiveCell.Text
'Column B has the email subject
'olMyEmail.Subject = ActiveCell.Offset(0, 1).Text
'Column C has the email Body
'Set doc = wd.Documents.Open(CStr(ActiveCell.Offset(0,
2).Hyperlinks.Item(1).Address))
' doc.Content.Select
' Set rng2 = doc.Content
'rng2.Text = doc.Content
' body = doc.Content.FormattedText
'body = rng2.Text
'olMyEmail.body = body
'doc.Close
'Attach using link from Column D
' olMyEmail.Attachments.add _
' CStr(ActiveCell.Offset(0, 3).Hyperlinks.Item(1).Address)
'Send Email
'olMyEmail.Send
'Go to Next Row
ActiveCell.Offset(1, 0).Select
Loop
MsgBox "You successfully sent the email & attachment."
Set olMyApp = Nothing
Set olMyEmail = Nothing
' Set doc = wd.Documents.Open _
' (Filename:="M:\Marlene PDF Test\Australian Market Update.doc",
ReadOnly:=True)
' Set itm = doc.MailEnvelope.Item
' With itm
' .To = "Address"
' .Subject = "Subject"
' .Save
' ID = .EntryID
' End With
' Set itm = Nothing
' Set itm = Application.Session.GetItemFromID(ID)
' itm.Send
' doc.Close wdDoNotSaveChanges
' If blnWeOpenedWord Then
' wd.Quit
' End If
Set doc = Nothing
Set itm = Nothing
Set wd = Nothing
End Sub
Thanks again!
Ken wrote:
Please post your code. It seems to me like what you are trying to do
should not be too dificult.
Ken
wrote:
Hello Everyone,
Here is the problem I am having......
I am trying to automatically attach a file to an email in Outlook every
week...right now the file is attaching and going to my drafts in
outlook, which is perfect.
The problem is that the filename changes every week. Right now the
name of the file is:
M:\Pricing\Weekly AUD and CAD\Canadian\2006.12.15 CAD Pricing.xls
Next week, the file will be:
M:\Pricing\Weekly AUD and CAD\Canadian\2006.12.27 CAD Pricing.xls
I have a formula in Excel that concatenates the file name and a formula
that creates it as a hyperlink and it opens...which is fine.
BUT- when I run the macro it doesn't attach the file when I use the
concatenated/hyperlink formula....however it did attach when I
hyperlinked the file on my own
I have a lot of files......and I need to do them weekly....so thats why
it would be difficult to this manually
In the end, I need a macro/formula/anything that can concatenate the
file name and then hyperlink it AND still work when I run my
macro...ANY help would be awesome!
Thanks everyone and happy holidays!
Reply With Quote
Ken
View Public Profile
Find all posts by Ken