Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

VBA Oultook/Excel - Wrzucanie kilku obszarów excela do treści maila

kunio_1 21 Sie 2015 11:58 882 4
  • #1 21 Sie 2015 11:58
    kunio_1
    Poziom 7  

    Witam,

    Mam makro przerzucające obszar Excela do treści maila. Obszar jednak jest za duży i słabo widoczny w mailu. Proszę o pomoc jak przerzucić kilka obszarów do jednego maila. Poniżej kod.

    Kod: vbscript
    Zaloguj się, aby zobaczyć kod

    0 4
  • #2 22 Sie 2015 12:37
    PRL
    Poziom 33  

    Proponuję załączyć pliki, skoro mejl jest nieczytelny.

    -1
  • #3 24 Sie 2015 14:24
    kunio_1
    Poziom 7  

    Chodzi o zautomatyzowanie wysyłki i raportów, pliku są załączane ręcznie co zajmuję za dużo czasu.

    0
  • #4 24 Sie 2015 14:32
    michson88
    Poziom 10  

    @kunio_1 proponuję zastosować właściwość HTMLBody i wtedy użyć funkcji Ron de Bruin'a:

    Code:
    Function RangetoHTML(rng As Range)
    

        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"

        'Copy the range and create a new workbook to past the data in
        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

        'Publish the sheet to a htm file
        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

        'Read all data from the htm file into RangetoHTML
        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=")

        'Close TempWB
        TempWB.Close savechanges:=False

        'Delete the htm file we used in this function
        Kill TempFile

        Set ts = Nothing
        Set fso = Nothing
        Set TempWB = Nothing
    End Function
    Wtedy przykładowy Twój kod powinien wyglądać tak:
    Code:
    olMsg.HTMLBody = RangetoHTML(TwojZakres)

    0
  • #5 24 Sie 2015 15:05
    PRL
    Poziom 33  

    Cytat:
    pliku są załączane ręcznie co zajmuję za dużo czasu


    To teraz już nie wiem.
    Chcesz w mejlu umieszczać zakresy arkuszy (która, jak mówisz, są nieczytelne), czy z automatu dodawać załączniki?
    Załączniki są w jednym folderze, tak aby to zautomatyzować?

    0