Hyperlink in outlook appointment

D

Dozo2000

New Member
Joined
Dec 8, 2016
Messages
24
Is it possible to copy a hyperlink from my excelsheet to my outlook agenda?

Everything works fine, but i am not able to get a working link in the body of the appointment.

This is what I have now...

Code: 
 For r = 4 To 220
        
        Link = Blad1.Cells(r, 125).Hyperlinks(1).Address
        Link = Application.Substitute(Link, "../", "")
        Link = Application.Substitute(Link, "/", "\")
        Link = Application.Substitute(Link, " ", "%20")
        Link = "file:C:///" & Link

   
        If Len(Blad1.Cells(r, 21).Value) = 0 Then GoTo NextRow
        
        sSubject = "[" & Blad1.Cells(r, 1).Value & "]  " & Blad1.Cells(r, 11).Value & " [" & Blad1.Cells(r, 22).Value & "]"
       
  sBody = Link
             
             
        dStartTime = Blad1.Cells(r, 21).Value + TimeValue("10:00:00")
        dEndTime = Blad1.Cells(r, 21).Value + TimeValue("11:00:00")
        sLocation = Blad1.Cells(r, 14).Value
        dReminder = 60
        sName = Blad1.Cells(r, 1).Value
        dCatagory = "Categorie Geel"
 
Sort by date Sort by votes
I adjusted it a little and have learned about range...

Code: 
Sub Run()
Dim excelLink As Excel.Hyperlink
    '' Set i=190 for TESTING only
    i = 190
    Company = Blad1.Cells(i, 11).Value
    Link = Blad1.Cells(i, 131).Value
    Pad = Environ("USERPROFILE")
    Link = Application.Substitute(Link, "C:\Users\Temp", Pad)
    Call Application.ActiveSheet.Hyperlinks.Add(Range("EB" & i), Link, TextToDisplay:=Company)
    Set excelLink = Excel.Range("EB" & i).Hyperlinks(1)
    Call CreateHyperlink(excelLink)
End Sub
Sub CreateHyperlink(excelLink As Excel.Hyperlink)
Dim OutApp As Object 'Oultook.Application
Dim Appt As Object 'Outlook.AppointmentItem
Dim Selection As Object 'Word.Selection
    Set OutApp = GetObject(, "Outlook.Application")
    Set Appt = Outlook.Application.CreateItem(olAppointmentItem)
    Appt.Display
    
    Set Selection = Appt.GetInspector.WordEditor.Windows(1).Selection
    '' Set i=190 for TESTING only
    i = 190
    Selection.TypeText ("Bellen met: " & Blad1.Cells(i, 15).Value & " over offerte (" & Blad1.Cells(i, 3).Value & ").")
    Selection.TypeText (vbNewLine & vbNewLine)
    Selection.TypeText ("Betreffende: " & Blad1.Cells(i, 23).Value & ".")
    Selection.TypeText (vbNewLine & vbNewLine)
    Selection.TypeText (Blad1.Cells(i, 11).Value & " - " & Blad1.Cells(i, 22).Value)
    Selection.TypeText (vbNewLine & vbNewLine)
    Selection.TypeText (vbNewLine & Blad1.Cells(i, 11).Value)
    Selection.TypeText (vbNewLine & Blad1.Cells(i, 12).Value)
    Selection.TypeText (vbNewLine & Blad1.Cells(i, 13).Value & " " & Blad1.Cells(i, 14).Value)
    Selection.TypeText (vbNewLine & vbNewLine)
    Selection.TypeText (vbNewLine & Blad1.Cells(i, 15).Value)
    Selection.TypeText (vbNewLine & Blad1.Cells(i, 16).Value)
    Selection.TypeText (vbNewLine & vbNewLine & vbNewLine)
    Selection.TypeText ("Klik hier voor datasheet van: " & Company & vbNewLine)
    Selection.Hyperlinks.Add Selection.Range, excelLink.Address, TextToDisplay:=excelLink.TextToDisplay
    
End Sub

So if I undertstand it correctly:


I have to insert the Sub Run() into my macro that I use to create the appointments; and modify it so it can be used in the loop.
And the Sub CreateHyperlinkAppointment(excelLink As Excel.Hyperlink) will be called to fill the body of the appointment.

Not using sBody anymore, but still using the other variable sSubject, date, etc?

Do I understand it right?

Many thanks!
 
Upvote 0

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Yep, you can still use sSubject and date as you had been. It's just sBody that wasn't going to work for what you wanted it to do.

It looks like you figured out that Range("A1") was just supposed to be an example to show you how to use the hyperlink, I didn't mean for you to try and incorporate that part into your code.

When you run the code as it stands right now does it do what you expect?
 
Upvote 0
When I run the code, it does exactly what I want!

But... when I insert it in my own, it shows me an error... Call CreateHyperlink(excelLink) -> (Compile error. expecting variable or procedure , not a module.)

What am I doing wrong?

Here is the code I have now: (Userform)

Code: 
Private Sub Mark_Click()
    Dim excelLink As Excel.Hyperlink
    Mystring = "MB"
    sVW = "Mark"
    Keuzes.Hide
    On Error Resume Next
    Set OL = GetObject(, "Outlook.Application")
    bOLOpen = True
    If OL Is Nothing Then
        Set OL = CreateObject("Outlook.Application")
        bOLOpen = False
    End If
    Set NS = OL.GetNamespace("MAPI")
    Set colItems = NS.GetDefaultFolder(olFolderCalendar).Items
    Set Selection = Appt.GetInspector.WordEditor.Windows(1).Selection
    
    UserVar = UserName()
    Pad = Environ("USERPROFILE")
        
    For r = 4 To 220
                             
        If Len(Blad1.Cells(r, 21).Value) = 0 Then GoTo NextRow
        
        sSubject = "[" & Blad1.Cells(r, 1).Value & "]  " & Blad1.Cells(r, 11).Value & " [" & Blad1.Cells(r, 22).Value & "]"
                        
        Link = Blad1.Cells(r, 131).Value
              
        Link = Application.Substitute(Link, " ", "%20")
        Link = Application.Substitute(Link, "/", "\")
        Link = Application.Substitute(Link, "C:\Users\Temp", Pad)
        Link = "[URL]file:///[/URL]" & Link
             
        dStartTime = Blad1.Cells(r, 21).Value + TimeValue("10:00:00")
        dEndTime = Blad1.Cells(r, 21).Value + TimeValue("11:00:00")
        sLocation = Blad1.Cells(r, 14).Value
        dReminder = 60
        sName = Blad1.Cells(r, 1).Value
        dCatagory = "Categorie Geel"
         
        If dStartTime > Date Then
        If Blad1.Cells(r, 18) <> 0 Then
        If sName = Mystring Then
                      
        OldDate = dStartTime
        OldWeekDay = Weekday(OldDate)
        If OldWeekDay = 1 Then
           NewDate = OldDate + 1
        ElseIf OldWeekDay = 2 Then
           NewDate = OldDate
        ElseIf OldWeekDay = 3 Then
           NewDate = OldDate + 3
        ElseIf OldWeekDay = 4 Then
          NewDate = OldDate + 2
        ElseIf OldWeekDay = 5 Then
          NewDate = OldDate + 1
        ElseIf OldWeekDay = 6 Then
          NewDate = OldDate
        ElseIf OldWeekDay = 7 Then
          NewDate = OldDate + 2
        End If
         
        sSearch = "[Subject] = " & sQuote(sSubject)
        Set olApptSearch = colItems.Find(sSearch)
        
        Company = Blad1.Cells(i, 11).Value
        Link = Blad1.Cells(i, 131).Value
        Pad = Environ("USERPROFILE")
        Link = Application.Substitute(Link, "C:\Users\Temp", Pad)
        Call Application.ActiveSheet.Hyperlinks.Add(Range("EB" & i), Link, TextToDisplay:=Company)
        Set excelLink = Excel.Range("EB" & i).Hyperlinks(1)
        Call CreateHyperlink(excelLink)
                 
        If olApptSearch Is Nothing Then
            Set olAppt = OL.CreateItem(olAppointmentItem)
            '' olAppt.Body = sBody
            olAppt.Subject = sSubject
            olAppt.Start = NewDate
            olAppt.End = dEndTime
            olAppt.ReminderMinutesBeforeStart = dReminder
            olAppt.Location = sLocation
            olAppt.Categories = dCatagory
            olAppt.Close olSave
        End If
        End If
        End If
        End If
NextRow:
    Next r
         
    If bOLOpen = False Then OL.Quit
    MsgBox "Reminders voor " + sVW + " aangemaakt in Outlook agenda...", vbMsgBoxSetForeground
    
End Sub
 
Upvote 0
O.. it was a name error of the module..
Its gone now after renaming...

The appointments are made by the macro, but the body is empty now.
 
Upvote 0
You need to move the logic in the "CreateHyperlink" method that is creating the outlook appointment and move it into your userform method (pretty much the Selection.Hyperlink and Selection.TypeText methods). For instance in your userform method you already created the outlook application so you don't need to move that part over. The logic for writing the message will go on top of your ".Body = sBody" line you commented out. Also make sure you rename your variables as needed. Other than that there isn't much more I can do for you.
 
Upvote 0
Yes! I am moving code from Macro to macro and it is almost working like I want it to!

Your code is working!!

Thank you very much for your help, time and patience!!

THX!!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Error 91 when pasting into outlook from excel using vba
Replies
3
Views
783
Micron
M
Z
  • Solved
add appointment to shared outlook calendar
Replies
2
Views
2K
zoog25
Z
M
  • Question Question
Add Hyperlink to Excel VBA Email Body
Replies
3
Views
13K
Logit
Logit
S
  • Question Question
Opening SharePoint Workbooks
Replies
3
Views
591
jkpieterse
jkpieterse
P
  • Question Question
Hyperlink to email, attach file, add subject line and body
Replies
3
Views
377
paun_shotts
P

Forum statistics

Threads
1,223,243
Messages
6,170,971
Members
452,371
Latest member
Frana

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top