PasteSpecial neemt maar 8 characters mee met kopiëren naar outlook.

[TEGO]

Hi,

De onderstaande code moet zorgen dat er een excelsheet wordt geopend > de gevulde cellen worden gekopieerd > omgezet naar een TEMPWB.html > geplakt naar een emailhtmlbody.
Echter plakt de code maar maximaal 8 tekens per kolom. Hoe kan ik dit oplossen? Andere pastespecial methodes werken niet.

Alvast bedankt!

Gr. TEGO

Sub CreateFromTemplate2()

    Dim myOlApp As Outlook.Application
    Dim MyItem As Outlook.MailItem
    Dim strlocation As String
    Dim StrBody As String
    Dim oxl As Object
     
strlocation = "C:\Users\...\Desktop\..\Daily transports " & Date & ".xlsx"

Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItemFromTemplate("C:\Users\..\..\ transporten.oft")


 Set oxl = CreateObject("Excel.Application")
                 'Dim vValue As Range
        Dim oBook As Workbook
        Dim oSheet As Worksheet
        Dim rng As Range
 
        Set oBook = oxl.Workbooks.Open(strlocation)
        Set oSheet = oBook.Worksheets("Sheet1")

        'Set vValue = oSheet.Range("A1:G3").Value   'Get the value from cell A1

Set rng = Nothing
' Only send the visible cells in the selection.

Set rng = oSheet.Range("A:F").SpecialCells(xlCellTypeVisible)

    MyItem.HTMLBody = RangetoHTML(rng)
 
    MyItem.Subject = ("Daily transports " & Date)
 
    'MyItem.Body = Replace(MyItem.Body, "%table%", vValue)

 'Set oSheet = Nothing
 'oBook.Close
 'Set oBook = Nothing
 'oxl.Quit
 'Set oxl = Nothing

MyItem.Display

End Sub

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
             
        On Error Resume Next
        .DrawingObjects.Visible = False
        .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

 

[edmoor]

Haal die Paste:=8 er eens uit weg.

 

[TEGO]

Hi Edmoor,

Bedankt dat je er naar wilt kijken, die paste:=8 verwijst naar het pastetype (in dit geval pastecolumnwidths) als ik het verwijder werkt het helemaal niet meer..

 

[snb]

Dat kan wel iets simpeler.

Zie: http://www.snb-vba.eu/VBA_Excelgegevens_mailen.html#L4

 

[TEGO]

Helaas werkt die code niet. Weet niet precies waarom, had deze eerst erin staan maar na veel proberen toch over gestapt op de vbcode van R.de Bruin alles werkt ook enkel het plakken van de tabel in de outlookbody gaat het gedeeltelijk fout.

 

[snb]

zet dan eens het Excel voorbeeldbestand (+aanduiding welk gebied in het mailbericht moet komen) hier neer.

 

[edmoor]

Hi Edmoor,

Bedankt dat je er naar wilt kijken, die paste:=8 verwijst naar het pastetype (in dit geval pastecolumnwidths) als ik het verwijder werkt het helemaal niet meer..

Je hebt helemaal gelijk. Ik las te snel en dus fout.
Excuus.

 

[TEGO]

zet dan eens het Excel voorbeeldbestand (+aanduiding welk gebied in het mailbericht moet komen) hier neer.

Het bestand is een variabele tabel. IVM vertrouwelijke informatie kan ik dit niet op dit forum plaatsen (de tabel leegmaken is een optie natuurlijk, zie bijlage). De tabel heeft 6 kolommen, kolom 1 is tekst, kolom 2 is datumveld, kolom 3 is tekst kolom 4 is nummeriek,kolom 5 en kolom 6 zijn tekst. Het aantal regels is niet vast. Alle gevulde cellen moeten met opmaak in de emailbody komen.