Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

add more text to myItem.Body in Outlook 2000

Status
Not open for further replies.

crabback

Technical User
Jan 29, 2007
64
IE
Hi

I have a macro that creates an email message and sets a link to a file in the the body of the email.
I want to write and additional sub that will allow the user to add other links to the body of the same message - is this possible? How would I do it? (I'm thinking there is probably a better way than what I am doing - )
This is my code. On the second Sub the problem I think is with the line containing
myOlApp.CreateItem(olMailItem)...

*** this sub creates a message and adds first link as body

Private Sub AddAction()
Dim FilePath, DocPath, DocName As String
FilePath = InputBox("What is the Directory of the attachment?", "File Path")
DocName = InputBox("What is the full name of the file?", "File Name")
DocPath = FilePath & "\" & DocName
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAction As Outlook.Action
Set myItem = myOlApp.CreateItem(olMailItem)
Set myAction = myItem.Actions.Add

myItem.Subject = "Attached files"
myItem.Body = vbCrLf & "file:\\" & ReplaceSpace(DocPath)
myItem.Display

End Sub

*** This sub SHOULD allow user to insert a new line into the message body

Private Sub MultiAtts()
Dim FilePath, DocPath, DocName As String
FilePath = InputBox("What is the Directory of the attachment?", "File Path")
DocName = InputBox("What is the full name of the file?", "File Name")
DocPath = FilePath & "\" & DocName
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAction As Outlook.Action
Set myItem = *** myOlApp.CreateItem(olMailItem)***
Set myAction = myItem.Actions.Add
myItem.Body = "file:\\" & ReplaceSpace(DocPath) & vbCrLf
myItem.Display
End Sub

Cheers [bigears]

Crabback
 

Crabback,

You're right; the hi-lited line of code in the second sub will be a problem. Since you are using the exact same variables in both routines, the second call is simply going to overwrite the original entry. It appears that containing the last four lines of code within a loop with a mechanism for the user to break the loop would solve the problem:

Code:
For j = 1 to 4
    Set myItem(j) = myOlApp.CreateItem(olMailItem)
    Set myAction = myItem(j).Actions.Add
    myItem(j).Body = "file:\\" & ReplaceSpace(DocPath) & vbCrLf
        Dim Msg, Style, Title, Response
        Msg = "Do you need another link?"
        Style = vbYesNo + vbInformation + vbDefaultButton2
        Title = "CHOOSE RESPONSE"
        Response = MsgBox(Msg, Style, Title)
           If Response = vbNo Then
             Exit Sub
           Else
             Next j
           End If
myItem.Display

Someone else may very well show both of us a quicker and easier way, but this should allow the user to add up to four new links (an arbitrary number for illustration only), breaking the loop when done.

[glasses]


----------------------------------------------------------------------------------
[small][ponder]"Did you hear about the guy who refused to pay his exorcist?[/small]
He was re-Possessed." [lol]
 
Thanks for replying WalkerEvans...
I tried this as you said but I get an error on the Next - saying there is no preceding For??? weird, it looks fine to me, did you get this to work?:
Private Sub AddAction()
Dim FilePath, DocPath, DocName As String
FilePath = InputBox("What is the Directory of the attachment?", "File Path")
DocName = InputBox("What is the full name of the file?", "File Name") '"test.doc"
DocPath = FilePath & "\" & DocName
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAction As Outlook.Action
Set myItem = myOlApp.CreateItem(olMailItem)
Set myAction = myItem.Actions.Add
For J = 1 To 4
Set myItem(J) = myOlApp.CreateItem(olMailItem)
Set myAction = myItem(J).Actions.Add
myItem(J).Body = "file:\\" & ReplaceSpace(DocPath) & vbCrLf
Dim Msg, Style, Title, Response
Msg = "Do you need another link?"
Style = vbYesNo + vbInformation + vbDefaultButton2
Title = "CHOOSE RESPONSE"
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then
Exit Sub
Else
Next J
End If
myItem.Display

End Sub

Cheers [bigears]


Crabback
 
Code:
        If Response = vbNo Then
             Exit Sub
           Else
 Next J
           End If

use an exit for instead and remove the else and move the next down

Chance,

F, G + yeah reached 50
 
Chance: You're right, that will solve the problem I inadvertently built into my response. Thanks.

Crabback: Modify as Chance has suggested to remove my error. As to whether or not the code ran for me, I didn't run a test through lack of time. It seemed a straight-forward loop so I just dashed the code off before my next meeting (it's been on of those days). I'm sorry for leading you into a blind alley by inverting a couple of code lines.

[sadeyes]

----------------------------------------------------------------------------------
[small][ponder]"Did you hear about the guy who refused to pay his exorcist?[/small]
He was re-Possessed." [lol]
 
Hi Again!

Lads, thanks so much for your help with this, I'm really appreciating it. I'm having one of those WEEKS Chance, so I feel for you. New job still using Office 2000 - clunk clunk, and I'm trying to write VBA for Outlook 2000 (never had the pleasure before [noevil])
Walker that worked in that it got rid of the error.. now I have a new one on line
Set myAction = myItem(J).Actions.Add
I get
run-time error '450':
Wrong number of arguments or invalid property assignment
... NOw the way I'm intepreting it is that myItem is my instance of the mail message - so by using this in my loop am I not creating, in this case, 4 mail messages?

Crabback
 
Hi
FYI I got this to work by creating a function that was called from the sub. I created a string variable to contain what I wanted as my HTMLBody, and used the function to add new lines to this string, finally I set myItem.HTMLbody to equal the final value of this string - I could add multiple attachments by calling the function from within itself. here is the code I used:

Private Sub AddAction()

Dim GetPathFilePath, DocPath, DocName, More, BodyContent As String
UserForm1.CommonDialog1.Action = 1
DocPath = UserForm1.CommonDialog1.FileName
FileName = Dir(DocPath, vbDirectory)
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAction As Outlook.Action
Set myItem = myOlApp.CreateItem(olMailItem)
Set myAction = myItem.Actions.Add
myItem.Subject = FileName
BodyContent = "<b>Hi</b><br>This is my message<br><a href='file:\\" _
& DocPath & "'>" & DocPath & "</a><br>"
More = MsgBox("Add another attachment?", vbYesNo)
If More = 6 Then
myItem.HTMLBody = AddMulti(BodyContent)
Else
myItem.HTMLBody = BodyContent
End If
myItem.Display
End Sub

Private Function AddMulti(BodyContent) As String
Dim GetPathFilePath, DocPath, DocName As String
UserForm1.CommonDialog1.Action = 1
DocPath = UserForm1.CommonDialog1.FileName
FileName = Dir(DocPath, vbDirectory)
BodyContent = BodyContent + "<a href='file:\\" & DocPath & "'>" & DocPath & "</a><br>"
More = MsgBox("Add another attachment?", vbYesNo)
If More = 6 Then
BodyContent = BodyContent
'MsgBox (BodyContent)
Call AddMulti(BodyContent)
End If
AddMulti = BodyContent
End Function

Crabback
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top