VBA Outlook

Tematy nie należące do żadnej z pozostałych kategorii

Moderator: Moderatorzy

VBA Outlook

Postprzez Feiran » Pt 18.09.2020 09:47

Cześć!

Stworzyłem sobie makro, które miałoby automatycznie tworzyć maile do różnych adresatów z różną treścią. Problem mam jednak z podstawianiem tabeli. Nie wiem jak określić funkcję, by tak jak to jest przy adresatach (czyli funkcja wiersz po wiersz tworzy maila i bierze adresatów tylko z aktualnej komórki, jak w kodzie), treść maila również zmieniała się tak jak adresaci. Poza tym istotne jest, by jedna część tabeli (nagłówki) zawsze była stała a jedynie druga (dane) się zmieniały. Czy ktoś może pomóc?

Kod: Zaznacz cały
Option Explicit

Sub Mail_TG()

    Dim rng As Range
    Dim mailRange As Range: Set mailRange = SheetMain.Range(SheetMain.Cells(6, 3), LastUsedCell(SheetMain, 3))
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    For Each rng In mailRange
        If rng.Value2 <> "" Then
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
            .To = rng.Value2
            .CC = SheetMain.Cells(rng.Row, 4)
            .Subject = "Ungenehmigte Zeitnachweise"
            .HTMLBody = RangetoHTML(rng)
            .Display
            End With
        End If
    Next rng

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub
Function RangetoHTML(rng As Range)

Set rng = SheetMain.Range(SheetMain.Cells(6, 9), SheetMain.Cells(6, 11))

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy

    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         FileName:=TempFile, _
         Sheet:=TempWB.Sheets(1).name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
   
    TempWB.Close SaveChanges:=False
 
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
Feiran
 
Posty: 2
Dołączył(a): Pt 18.09.2020 09:43

Re: VBA Outlook

Postprzez OShon » Pt 18.09.2020 10:20

Widzę że to Excelowy kod.
Jeśli chcesz napisać mechanizm wysyłania danych oparty na rekordach arkusza to musisz uposażyć procedurę w pętlę.
W niej musisz wrzuć funkcję, która będzie otrzymywała parametry i w iteracji realizowała działanie.

Robisz podobnie. Masz pętlę For na zakresie i przekazujesz wprost dane do tworzenia poczty
Kod: Zaznacz cały
.To = rng.Value2
.CC = SheetMain.Cells(rng.Row, 4)
.HTMLBody = RangetoHTML(rng)


I jej nie wysyłasz ale utworzoną obiektem OutMail pokazujesz na ekranie W czym problem zatem?
Wydaje mi się że nie pisałeś tego kodu bo podstawianie za linijkę .Subject = "Ungenehmigte Zeitnachweise"
np takiego wyrażenia nasuwa się bez problemu
Kod: Zaznacz cały
.Subject = SheetMain.Cells(rng.Row, 2) ' no treść z 2giej kolumny tego samego arkusza
.Subject = mailRange.Cells(rng.Row, 2) ' no treść z 2giej kolumny z zapamiętanego zakresu
.Subject = rng.offset(,2) ' jak wyżej inny sposób przez skok jeśli mailRange jest jednowymiarowy

albo stała wartość z komórki
Kod: Zaznacz cały
.Subject = SheetMain.Cells(1,1) ' treść z zawsze z A1


No chyba ze nie łapie pytania.
Jeśli tak to doprecyzuj.
Obrazek
Oskar Shon - MVP Office Dev. 11/22, 3x MCC, 4/9/22 TechNet
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 11151
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: VBA Outlook

Postprzez Feiran » Pt 18.09.2020 10:51

Pytanie faktycznie było inne, ale i tak mi ta odpowiedź pomogła! Teraz faktycznie do adresata przypisanego w wierszu 3 podstawia mi się tabela, która też jest w tym wierszu i tak dalej. Pozostał mi jeden problem - potrzebuję, by część podstawionej tabeli była zawsze stała, czyli nagłówki tabeli dla każdego przypadku, a część zmienna (co już udało się uzyskać).

[Function RangetoHTML(rng As Range)

Set rng = SheetMain.Range(SheetMain.Cells(rng.Row, 9), SheetMain.Cells(rng.Row, 11))
Feiran
 
Posty: 2
Dołączył(a): Pt 18.09.2020 09:43

Re: VBA Outlook

Postprzez OShon » Pt 18.09.2020 11:02

Masz jeszcze jakies pytania?
Jeśli tak, to czasem lepiej z jakimś obrazkiem lub spreparowanym i podłączonym do posta przykładem.
No i zapraszam ponownie bo widzę że jesteś now na forum.
Obrazek
Oskar Shon - MVP Office Dev. 11/22, 3x MCC, 4/9/22 TechNet
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 11151
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl


Powrót do Inne

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników i 4 gości