Automatyczne UDW dla każdej wiadomości

Pytania, uwagi, problemy związane z Microsoft Office Outlook, wersje 2007, 2010, 2013 i 2016.

Moderator: Moderatorzy

Re: Automatyczne UDW dla każdej wiadomości

Postprzez Szyna11 » So 07.07.2018 21:07

Sorry za być może głupie pytanie (dopiero zaczynam w vba) czy nie zadziała z samym If? Tylko nie mam pomysłu jak to ubrać.
Szyna11
 
Posty: 7
Dołączył(a): So 07.07.2018 17:55

Re: Automatyczne UDW dla każdej wiadomości

Postprzez OShon » So 07.07.2018 21:52

No if to warunek (jak najbardziej właściwy), a w nim masz sprawdzić jakie konto realizuje w pętli czynność wysłania wiadomości.

Ale może inaczej - nie wiem czy trafi to do ciebie - ale problem jest bardzo łatwy do zrozumienia..
    W klasie masz 10 osób, karzesz im ustawić się w szeregu (taka pętla), aby każdy z nich się przedstawił.
    Kaśka, Krzysiek, Waldek, Marysia...W konsekwencji zapisujesz tylko ostatnie imię, bo masz tylko jedną kartkę o nazwie "konto"
    Potem sprawdzasz który z nich się nazywa jeden.

A więc warunkiem pytasz o co innego niż zapamiętałeś w zmiennej. Ustawienie 2ch pętli jest błędne.
Po ustawieniu ich w szeregu (pętla) podczas odliczania od razu podejmiesz decyzję, który numer konta jest właściwy, lub który to będzie po nazwie.

Możesz sobie pomóc po przez przechodzenie kodu krokowo.
Ustaw sobie Breaking Point lub wpisz komendę STOP i przechodź klikając [F8] poruszając się po kolejnych liniach kodu.

XL_VBA_Breaking_point.png
XL_VBA_Breaking_point.png (7.38 KiB) Przeglądane 1850 razy
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9796
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczne UDW dla każdej wiadomości

Postprzez Szyna11 » Pn 09.07.2018 07:06

Kod: Zaznacz cały
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 Dim olNS As Outlook.NameSpace
 Set olNS = Application.GetNamespace("MAPI")

 Dim x&
 For x = 1 To olNS.Accounts.Count
 konto = olNS.Accounts.Item(x).DisplayName
 Next x
 
 If konto = email@xx.pl Then
    Dim oRecip As Recipient
    Set oRecip = Item.Recipients.Add("email@xx.pl")
    oRecip.Type = olBCC
    oRecip.Resolve
    Set oRecip = Nothing
End If
End Sub


Trochę kumam ale gdy wstawiam adres mail to wyskakuje błąd. Prośba gdyby ktoś poprawił ten kod na prawidłowy. Szczerze próbowałem i sam nie dam rad :(
Szyna11
 
Posty: 7
Dołączył(a): So 07.07.2018 17:55

Re: Automatyczne UDW dla każdej wiadomości

Postprzez OShon » Pn 09.07.2018 09:00

Wsadź warunek w pętlę, bo nadpisujesz zmienną konto i w efekcie otrzymujesz ostatnią nazwę weń wpisaną.
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9796
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczne UDW dla każdej wiadomości

Postprzez Szyna11 » Pn 09.07.2018 09:14

Kod: Zaznacz cały
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 Dim olNS As Outlook.NameSpace
 Set olNS = Application.GetNamespace("MAPI")

 Dim x&
 For x = 1 To olNS.Accounts.Count
 konto = olNS.Accounts.Item(x).DisplayName

 
 If konto = xxx Then
    Dim oRecip As Recipient
    Set oRecip = Item.Recipients.Add("email@xx.pl")
    oRecip.Type = olBCC
    oRecip.Resolve
    Set oRecip = Nothing
End If
Next x
End Sub


Czy tak powinno wyglądać?
Szyna11
 
Posty: 7
Dołączył(a): So 07.07.2018 17:55

Re: Automatyczne UDW dla każdej wiadomości

Postprzez OShon » Pn 09.07.2018 12:57

No tak :)
i zamiast xxx twoja nazwa konta, którą zwraca .DisplayName
tego konta, na który chcesz tej reakcji.
W tedy wysyłany mail przez to konto otrzyma dodatkowy adres.
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9796
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczne UDW dla każdej wiadomości

Postprzez Szyna11 » Pn 09.07.2018 13:07

Przechwytywanie.PNG
A czy tą nazwę, w moim przypadku mail:
1 - x.yyyyyyy@www.eu"
2 - y.xxxx@www.eu"
trzeba wstawić w jakiś sposób? Gdy wstawiam samego maila to jest błąd składni.
Szyna11
 
Posty: 7
Dołączył(a): So 07.07.2018 17:55

Re: Automatyczne UDW dla każdej wiadomości

Postprzez OShon » Pn 09.07.2018 13:52

Stringi należy dawać w apostrofach - tak ja użyłeś adres e-mai w dodaniu do kolekcji adresatów.
a zmienną konto należy określić na początku procedury, o czym wspominałem na początku naszej rozmowy.
Kod: Zaznacz cały
Dim konto as string
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9796
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczne UDW dla każdej wiadomości

Postprzez Szyna11 » Wt 10.07.2018 15:14

Niestety nie działa ale dzięki za pomoc.
Szyna11
 
Posty: 7
Dołączył(a): So 07.07.2018 17:55

Re: Automatyczne UDW dla każdej wiadomości

Postprzez ola65 » Śr 05.12.2018 21:39

Hej,

Chciałabym prosić Was o pomoc z makrem do dodwaia UDW. Mam w pracy kilka wspólnych skrzynek, a każdy użytkownik ma inną ilość i ich kolejność. Chciałabym aby wysyłając maila ze skrzynki grupowej, zawsze dodawało się UDW z adresem skrzynki, z której wysłało się maila. Nie umiem napisać kodu, że From = UDW i dodać warunku, nigdy nie dodawaj UDW=From, jeśłi adres jest równy jan.kowalski@op.pl" target="_blank. Znalazłam poniższy kod (choć nie spełnia moich wszsytkich warunków), ale dodaje UDW tylko jak wysyłam z prywatnej skrzynki a nie z grupowej. Będę wdzięczna za wszelką pomoc :)


Kod: Zaznacz cały
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim strMsg As String
Dim res As Integer
Dim strBcc As String
On Error Resume Next

strBcc = "XXX@XXX.com"

' Use the account name as it appears in Account Settings
If Item.SendUsingAccount = "XX@XX.com" Then

Set objRecip = Item.Recipients.Add(strBcc)
objRecip.Type = olBCC
If Not objRecip.Resolve Then
    strMsg = "Could not resolve the Bcc recipient. " & _
             "Do you want to send the message?"
    res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
            "Could Not Resolve Bcc")
    If res = vbNo Then
        Cancel = True
    End If
  End If

End If

 Set objRecip = Nothing
End Sub
ola65
 
Posty: 1
Dołączył(a): Śr 05.12.2018 21:31

Poprzednia strona

Powrót do Microsoft Outlook 2007 / 2010 / 2013 / 2016

Kto przegląda forum

Użytkownicy przeglądający ten dział: Google [Bot] i 6 gości

cron