Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 64444 Skopiuj do schowka dodawanie linku do wydarzenia
Autor Wiadomość
negatyv
Excel Expert



Zaproszone osoby: 393
Pomógł: 338 razy
Posty: 1720
Wysłany: 15-03-2019, 12:43   dodawanie linku do wydarzenia

Witajcie,
Znowu życie mnie rzuciło na chwilę na linię frontu VBA. Mam poniższy problem z dodaniem wydarzenia do outlooka.

Wydarzenie się dodaje, link też. Kiedy jednak otwieram wydarzenie w outlooku i próbuję je zamknąć to mam pytanie "Czy chcę zapisać". Jeśli kliknę "nie" to łącze znika z treści. Jakby dodawanie linku zostawiało wydarzenie w stanie "niezapisanym". Jeżeli wykomentuję kod dodający link, to outlook nie zadaje tego pytania.

Kod w dużej mierze wygooglany, żadnych czarów tam nie ma. Poniżej kod i plik w załączniku.

Co o tym myślicie?

Kod:
Sub Dodaj_termin()
'Dodawanie terminów do kalendarzy udostępnionych

   Sheets("Terminy").Select
    On Error GoTo Err_Execute
   
    Dim olApp As Object
    Dim olAppt As Object
    Dim blnCreated As Boolean
    Dim olNs As Object
    Dim CalFolder As Object
    Dim subFolder As Object
    Dim objOwner As Object
    Dim arrCal As String
    Dim strRTF As String

   
    Dim i As Long

    On Error Resume Next
    Set olApp = CreateObject("Outlook.Application")
   
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
         blnCreated = True
        Err.Clear
    Else
        blnCreated = False
    End If
   
    On Error GoTo 0
   
    Set olNs = olApp.GetNamespace("MAPI")

    'Pobieranie nazwy kalendarza z arkusza w kolumnie A
    i = 2
    Do Until Trim(Cells(i, 1).Value) = ""
        arrCal = Cells(i, 1).Value
       
        'Definiowania kalendarza do którego ma zostać dodane wydarzenie
        Set objOwner = olNs.CreateRecipient(arrCal)
            objOwner.Resolve
        Set CalFolder = olNs.GetSharedDefaultFolder(objOwner, 9) 'olFolderCalendar)
       
        Set olAppt = CalFolder.Items.Add(1)  'olAppointmentItem)
       
        link = Replace(Cells(i, 12).Value, " ", "%20")
        link = Replace(link, "&", "%26")

   
        'Dodawanie terminu do kalendarza
        With olAppt
        'Define calendar item properties,
             
            .Start = Cells(i, 6) + Cells(i, 7)
            .End = Cells(i, 8) + Cells(i, 9)
            .Subject = Cells(i, 2).Value
            .Location = Cells(i, 3).Value
            .body = Cells(i, 4).Value & Chr(10)
            .BusyStatus = olBusy
            .ReminderMinutesBeforeStart = Cells(i, 10).Value
            .ReminderSet = True
            .Categories = Cells(i, 5).Value
        End With
       
        InsertLink olAppt, "file://" & link, "Dodany plik"
        olAppt.Save
       
        Sheets("Terminy").Cells(i, 11) = "OK"
        i = i + 1
    Loop
    Set olAppt = Nothing
    Set olApp = Nothing

    MsgBox "Wszystkie terminy zostały dodane do kalendarzy."

    Exit Sub
   
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar."

End Sub

Sub InsertLink(msg As Object, strLink As String, strLinkText As String)
    Dim objInsp As Object 'Outlook.Inspector
    Dim objDoc As Object 'Word.document
    Dim objSel As Object 'Word.Selection
     

    Set objInsp = msg.GetInspector
    Set objDoc = objInsp.WordEditor
    Set objSel = objDoc.Windows(1).Selection
    objSel.Move 4, 1
    objSel.Move 4, 1
    objSel.Move 4, 1
    objSel.Move 4, 1

    objDoc.Hyperlinks.Add objSel.Range, strLink, _
                            "", "", strLinkText, ""
   
    Set objInsp = Nothing
    Set objDoc = Nothing
    Set objSel = Nothing
End Sub


link_do_outlooka.xlsm
Pobierz Plik ściągnięto 13 raz(y) 24.71 KB

_________________
http://www.123office.pl - blog poświęcony programom pakietu MS Office.

Kurs VBA | LinkedIn
ID posta: 364297 Skopiuj do schowka
 
 
negatyv
Excel Expert



Zaproszone osoby: 393
Pomógł: 338 razy
Posty: 1720
Wysłany: 15-03-2019, 13:08   

Na ten moment rozwiązałem to przez otwieranie na moment okna wydarzenia i zamykanie, ale jakieś to lewe rozwiązanie. W każdym razie jak ktoś tu trafi z podobnym problemem, to może mu pomoże.

Kod:
        olAppt.display
        olAppt.Close 1
        olAppt.Save
_________________
http://www.123office.pl - blog poświęcony programom pakietu MS Office.

Kurs VBA | LinkedIn
ID posta: 364300 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe