VBA - wysyłanie maili poprzez makro

3
0
1

Szanowne Państwo.

Stworzyłem makro, które wysyła wiadomości mailowe do poszczególnych osób. Jednak makro jest bardzo manualne, gdyż każdą zmianę osób kontaktowych, bądź samej nazwy załącznika - muszę bezpośrednio zmieniać w kodzie VBA.

1. Chciałbym zautomatyzować makro, poprzez zaciąganie adresatów z zakładki "TEST" z całej kolumny "A".

Na ten moment mój kod wygląda następująco:

Sub TEST()

    Dim OutApp As Object
    Dim OutMail As Object
    
    adresat = Worksheets("TEST").Range("A:A").Value
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = adresat
'       .CC = "przykładowy@mail.com"
        .Subject = "November Report 2019"
        .Body = "Dear colleagues," & vbCrLf & _
            "" & vbCrLf & _
            "November report in attachment." & vbCrLf & _
            "" & vbCrLf & _
            "Kind Regards," & vbCrLf & _
            "" & vbCrLf & _
            "Tobiasz Kusch" 
        .Attachments.Add ("C:\[...]\MDC_CH_REPORT\MDC_CH_REPORT 11.2019.xlsx")
'       .Send
        .Display 'informacja o tym, czy chcemy obejrzec e-mail przed wyslaniem

    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

Aktualnie w.w. kod wywołuje następujący błąd:

Run-time error ‘440’:

The object does not support this method.

W jaki sposób/czy jest możliwość odwołać się do zakładki "TEST" kolumny "A" tak, aby w przypadku dodania/usunięcia osoby kontaktowej (1 osoba = 1 linijka) nie musiałbym zmieniać kodu VBA?

2. Kolejny problem, z którym się zmagam to zmiana nazw załączników.

Co miesiąc będę wysyłał załączniki o innej nazwie. Głównie zmienia się format daty dopisywany do pliku. Niemniej jednak stworzyłem dla każdego maila osobny folder, a każdy mail to osobne makro (w.w. przykład "TEST" to jeden z nich), które za pomocą końcowego makra (funckja Call) wywołuje wszystkie makra jednocześnie.

Jak przekształcić kod .Attachments.Add tak, aby nie zaciągał dokładnego pliku, tylko wszystkie pliki, które pojawią się w danym folderze?

Możemy przyjąć, że folder nazywa się "MDC_CH_REPORT".

Za każdą radę, będę bardzo wdzięczny!

Dziękuję.

Zapytał
@ Tobiasz_Kusch_5elj | 11.12.2019
- 0
- 0
- 0

1

1) Przypisując całą kolumnę do zmiennej, tworzysz tablicę wartości, której nie możesz bezpośrednio podać do metody .To, musisz zamienić ją najpierw na ciąg tekstowy, łącząc elementy tej tablicy. W kodzie użyłem metody End(xlUp), żeby znaleźć ostatnią niepustą komórkę w kolumnie, używanie całej kolumny jest tu zupełnie niepotrzebne i może powodować potencjalne problemy.

2) Możesz użyć np. funkcji Dir i przejść w pętli poprzez zwracane przez nią elementy (ścieżki do kolejnych plików w danym katalogu).

Sub TEST()
Dim OutApp As Object, adresaci, sciezka$, att$

With ThisWorkbook.Worksheets("TEST")
   adresaci = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With

If IsArray(adresaci) Then adresaci = Join(WorksheetFunction.Transpose(adresaci), "; ")

sciezka = "C:\MDC_CH_REPORT\"

Set OutApp = CreateObject("Outlook.Application")

With OutApp.CreateItem(0)
   .To = adresaci
   '.CC = "przykładowy@mail.com"
   .Subject = "November Report 2019"
   .Body = "Dear colleagues," & vbCrLf & vbCrLf & _
   "November report in attachment." & vbCrLf & vbCrLf & _
   "Kind Regards," & vbCrLf & vbCrLf & _
   "Tobiasz Kusch"
   
   att = Dir(sciezka)
   Do While att <> ""
      .Attachments.Add sciezka & att
      att = Dir
   Loop
   
   '.Send
   .Display 'informacja o tym, czy chcemy obejrzec e-mail przed wyslaniem
End With

Set OutApp = Nothing

End Sub

Skomentuj

Odpowiedział
@ Mirosław_Janiak | 11.12.2019
- 1
- 7
- 1

Pytanie