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
Przesunięty przez: Artik
21-04-2020, 11:10
Reużywalność Outlook.Application
Autor Wiadomość
Beginner_here
świeżak


Wersja: Win Office 2016
Posty: 4
Wysłany: 21-04-2020, 08:01   Reużywalność Outlook.Application

Cześć.
Na wstępie zaznaczę, że z makrami mam tyle wspólnego co nic, więc jeśli pytanie jest dla was trywialne - wybaczcie.

Chciałem uprościć sobie życie w pracy i za pomocą przycisków w excelu wysyłać maile. Każdy przycisk to nowy adresat. Czy w związku z tym za każdym razem muszę powielać kod?
Mam takich przycisków 9 i excel waży ponad 8MB...

Poniżej kod, był tutaj 1 IF, ale pozwoliłem go sobie usunąć..
Chodzi o to, że w tych mailach zmieniają się tylko wartości zmiennych :
odbiorca, dw, temat, tresc.


Kod:

Sub Wysylka1_Click()

Dim OutApp As Object
    Dim OutMail As Object
    Dim wbPath As String
    Dim odbiorca, dw, temat, tresc, As String
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
   
    wbPath = ThisWorkbook.Path
   

    With Sheets("Start")
  odbiorca = .Range("E15").Value
    dw = .Range("F15").Value
    temat = .Range("H15").Value
    tresc = .Range("I15").Value
    End With
     
    With ActiveWorkbook
    .Sheets(Array("a1", "a2", "a3", "a4")).Visible = False
    .Sheets("Start").Visible = True
    .Save
    End With
   
    With OutMail
        .To = odbiorca
        .CC = dw
        .Subject = temat
        .Body = tresc
        .Display
        '.Send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End If

End Sub


Z góry dziękuję wam za pomoc!
ID posta: 386022 Skopiuj do schowka
 
 
wczesny 
Exceloholic


Wersja: Win Office 2016
Pomógł: 21 razy
Posty: 179
Wysłany: 21-04-2020, 10:47   

Bez struktury pliku ciężko wyrokować, ale twoje zmienne odnoszą się do skoroszytu "Start" i jeżeli tam będą się zmieniać odpowiednie dane, to wystarczy jeden przycisk :)
ID posta: 386044 Skopiuj do schowka
 
 
Beginner_here
świeżak


Wersja: Win Office 2016
Posty: 4
Wysłany: 21-04-2020, 11:10   

wczesny generalnie jest tak, że mam n odbiorców..
Powiedzmy, że w mamy tabelę A - D , wiersze 1 - 5.
I tak oto mamy w :
A - odbiorca
B - dw
C - temat
D - treść
I dla każdego wiersza od 1 - 5 jest odpowiedni nadawca/ treść..

Chodzi mi o to, czy da się jakoś zapisać samo wywołanie maila, ale żeby w/w wartości były wywoływane inaczej... Waga tego pliku jest zdecydowanie za duża :(
ID posta: 386049 Skopiuj do schowka
 
 
wczesny 
Exceloholic


Wersja: Win Office 2016
Pomógł: 21 razy
Posty: 179
Wysłany: 21-04-2020, 12:00   

Skąd procedura ma wiedzieć, do kogo chcesz wysłać wiadomość? Zaznaczenie wiersza czy jak?
ID posta: 386053 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 291 razy
Posty: 1431
Wysłany: 21-04-2020, 12:01   

Beginner_here napisał/a:
czy da się jakoś zapisać samo wywołanie maila

W załączniku masz układ tabelki, którego tyczy się poniższe makro - "co_wcisniete".
Makro działa w obrębie arkusza "Arkusz1" - potrzeba innej nazwy (?) - zmień ją na inną.
Podpinasz je pod każdy z przycisków.
Każdy przycisk ma schemat nazwy "Jakaś_nazwa_KolejnyNumer".
Makro wycina "KolejnyNumer", który użyty zostaje do identyfikacji komórki z danymi do wysłania.
Zawartość komórek przypisana zostaje zmiennym, które przekazywane są do twojego makra "Wyslij", lekko zmodyfikowanego.
W konstrukcję twojego makra nie wnikam ... może i ono działa, jak powinno.
Kod:
Option Explicit

Sub co_wcisniete()
    Dim odb As String, dow As String, tmt As String, trsc As String
    Dim ktory_to
   
    With ThisWorkbook.Sheets("Arkusz1")
        ktory_to = Split(.Shapes(Application.Caller).TextFrame.Characters.Text, " ")(1)
        If Not IsNumeric(ktory_to) Then MsgBox "Kiszka druciana z nazwą przycisku": Exit Sub
        ktory_to = CInt(ktory_to) + 1
       
        odb = Application.Trim(.Range("A" & ktory_to).Value)
        dow = Application.Trim(.Range("B" & ktory_to).Value)
        tmt = Application.Trim(.Range("C" & ktory_to).Value)
        trsc = Application.Trim(.Range("D" & ktory_to).Value)
    End With
   
    Call wyslij_im_to(odb, dow, tmt, trsc)
End Sub

Sub wyslij_im_to(odbiorca As String, dw As String, temat As String, tresc As String)
    Dim wbPath As String ' => ???
    Dim OutApp As Object, OutMail As Object
   
    wbPath = ThisWorkbook.Path ' => ???
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
   
    With ActiveWorkbook
        .Sheets(Array("a1", "a2", "a3", "a4")).Visible = False
        .Sheets("Start").Visible = True
        .Save
    End With
   
    With OutMail
        .To = odbiorca
        .CC = dw
        .Subject = temat
        .Body = tresc
        .Display
        '.Send
    End With
   
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


obr01.jpg
Plik ściągnięto 16 raz(y) 67.7 KB

ID posta: 386054 Skopiuj do schowka
 
 
Beginner_here
świeżak


Wersja: Win Office 2016
Posty: 4
Wysłany: 21-04-2020, 13:30   

ąćęłńóś napisał/a:


Jesteś moim Bogiem!!!!

Jedyne co zmodyfikowałem to ten wiersz :

Kod:
Sub wyslij_im_to(odb As String, dow As String, tmt As String, trsc As String)


Ponieważ wcześniej były tam pełne "stare nazwy".
Nie mniej jednak - WIELKIE DZIĘKUJĘ!!
ID posta: 386064 Skopiuj do schowka
 
 
Beginner_here
świeżak


Wersja: Win Office 2016
Posty: 4
Wysłany: 11-05-2020, 18:05   

@ąćęłńóś

Wracam jak bumerang... Nagle przy wywoływaniu tego makra przy linijce :

Kod:
 ktory_to = Split(.Shapes(Application.Caller).TextFrame.Characters.Text, " ")(1)


Pojawia mi się Error 13 - Type mismatch

Jakiś pomysł ? :(

Już rozumiem. Przy wywołaniu alt+f11 wywala błąd.. Podczas uruchamiania z przycisku nie! :)
ID posta: 387204 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 291 razy
Posty: 1431
Wysłany: 12-05-2020, 00:00   

To właściwość "Caller" - jeśli nie został "zaktywowany" żaden wyzwalacz, to skąd polecenie to ma pobrać odpowiednią wartość ? Poczytaj o "Application.Caller".
ID posta: 387217 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