Tabblad mailen

[ronsom]

Goedemorgen,

Ik heb onderstaande code gevonden op het internet en deze in een module in mijn werkmap geplaatst.

Sub Mail_Sheets()
'For Tips see: http://www.rondebruin.nl/win/winmail/div/tips.htm
'Working in Excel 2000-2016
    Dim wb As Workbook
    Dim Shname As Variant
    Dim Addr As Variant
    Dim N As Integer
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim I As Long

    Shname = Array("Sheet1")
    Addr = Array("ron@test.nl", "jelle@test.nl", "judith@test.nl", "nicolet@test.nl")

    If Val(Application.Version) >= 12 Then
        'You run Excel 2007-2016
        FileExtStr = ".xlsm": FileFormatNum = 52
    Else
        'You run Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    End If

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

    TempFilePath = Environ$("temp") & "\"

    'Create the new workbooks/Mail it/Delete it
    For N = LBound(Shname) To UBound(Shname)

        TempFileName = "Sheet " & Shname(N) & " " & Format(Now, "dd-mmm-yy h-mm-ss")

        ThisWorkbook.Sheets(Shname(N)).Copy
        Set wb = ActiveWorkbook

        With wb
            [COLOR="#FF0000"].SaveAs TempFilePath & TempFileName & FileExtStr, FileFormatNum[/COLOR]
            On Error Resume Next
            For I = 1 To 3
                .SendMail Addr(N), _
                          "This is the Subject line"
                If Err.Number = 0 Then Exit For
            Next I
            On Error GoTo 0
            .Close SaveChanges:=False
        End With

        'Delete the file you have send
        Kill TempFilePath & TempFileName & FileExtStr

    Next N

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

Zoals ik het begrijp zal de code sheet 1 van de werkmap naar de 4 e-mail adressen sturen.
Dat lukt niet , ik krijg een fout melding.
De rode tekst is de foutmelding.
Hoe kan ik dit oplossen.

Bij voorbaat dank

Gr Ronsom

 

[Haije]

Ronsom, zou dit werken?

.SaveAs TempFilePath & TempFileName & FileExtStr

 

[ronsom]

Hallo Haije,

Bedankt voor je reactie.
De code maakt van de Sheet1 een bestand met de naam Map1.xlsx, terwijl ik in de code lees dat er een .xlsm bestand van gemaakt moet worden.
Begrijp ik dit goed.
Na het aanpassen van de code krijg ik toch nog dezelfde foutmelding.

Gr Ronsom

 

[edmoor]

Die rode regel laat alleen zien op welke regel de foutmelding zich voordoet. Van belang echter is de foutmelding zelf.

 

[ronsom]

Aha ik denk dat ik begin te begrijpen.
Het bestand waar ik in werk is een .xlsb bestand en de foutmelding geeft aan dat de extensie niet gebruikt kan worden met het geslecteerde bestandstype.
Hoe ga ik dit oplossen

Gr Ronsom

 

[edmoor]

In de code wordt zo te zien het bestand opgeslagen als .xlsm bestand en wordt hiervoor code 52 gebruikt. Op een Windows machine is dat goed, op een Mac is dat niet goed en zou je code 53 moeten gebruiken. Als je op een Windows PC werkt zou ik toch graag even een afdrukje willen zien van schermpje met de foutmelding.

 

[HSV]

Maak van:

Shname = Array("Sheet1")

eens....

Shname = "Sheet1"

En van....

TempFileName = "Sheet " & Shname(N) & " " & Format(Now, "dd-mmm-yy h-mm-ss")

....

TempFileName = "Sheet " & [COLOR=#FF0000]Shname[/COLOR] & " " & Format(Now, "dd-mmm-yy h-mm-ss")

 

[snb]

Iets eenvoudiger:

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

 

[ronsom]

Bedankt allemaal voor jullie reacties,

De code van snb werkt het makkelijkst, alleen stuurt hij het bestand weg als .xlsbxlsb bestand.
Hoe kan dit aan gepast worden

Gr Ronsom

 

[snb]

Welke code gebruik je nu (maak het de helpers eens wat gemakkelijker !)

 

[ronsom]

Ik had een fout gemaakt, nu werkt het prima.
Alleen hij verwijdert de kopie niet. De code zet de kopie weg en mailt deze dan maar verwijdert de kopie niet. Klopt dit?

Gr Ronsom

 

[ronsom]

de code van snb

excuses voor het de onduidelijkheid

 

[ronsom]

Sub enkel_werkblad_integraal_sturen() 
Application.DisplayAlerts = False

 c00 = "E:\OF\bestandsnaam." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
 c01 = ThisWorkbook.FileFormat

 ThisWorkbook.Sheets("Blad1").Copy

 With ActiveWorkbook 
.SaveAs c00, c01
 .Close False
End With

 With CreateObject("Outlook.Application").createitem(0) 
.to = "snb@forums.eu"
 .Subject = "example"
 .attachments.Add c00
 .Send
End With
End Sub

 

[Haije]

Ik had een fout gemaakt, nu werkt het prima.
Alleen hij verwijdert de kopie niet. De code zet de kopie weg en mailt deze dan maar verwijdert de kopie niet. Klopt dit?

Gr Ronsom

Ronsom,

in je oorspronkelijke code stond o.a.

        'Delete the file you have send
        Kill TempFilePath & TempFileName & FileExtStr

Dat zorgde daar voor het verwijderen en iets dergelijks vind ik niet in je laatst geposte code....

 

[ronsom]

Hallo allemaal,

Ik heb de code van snb gebruikt en eraan toegevoegd dat hij het bestand verwijdert wordt.
Iedereen bedankt voor de hulp.

Gr Ronsom