• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Link naar email

Status
Niet open voor verdere reacties.
W

WVE

Gebruiker
Lid geworden
14 sep 2017
Berichten
28
Beste hulpverleners,

In excel heb ik een opzetje gemaakt waar dagelijks iets in gewijzigd moet worden en vervolgens naar een vast emailadres gestuurd moet worden. Is het mogelijk om een soort hyperlink o.i.d. in het bestandje te zetten, dat zodra iemand de link aanklikt het huidige (net ingevulde) bestand meteen als bijlage aan een nieuwe mail wordt toegevoegd en de (vaste) geadresseerde wordt ingevuld?

Is er iemand die weet hoe dit moet, of een andere manier kent wat deze shortcut nabootst?

Met vriendelijke groet,

WVE
 
Deze komt van de site van Ron de Bruin, daar vind je veel handige dingen omtrent mailen via excel.

Als je een knop op je werkblad zet waar deze code aan gekoppeld is, moet je volgens mij een heel eind komen.

Code: 
Sub Mail_workbook_Outlook_1()

ActiveWorkbook.Save
    
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

 
    With OutMail
        .to = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add ActiveWorkbook.FullName
        .Display
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Laatst bewerkt:
Beste SjonR,

De code die je mij gaf lost perfect het probleem op wat ik beschreef! Echter kwam ik daardoor tot de conclusie dat ik mijn probleem verkeerd probeerde op te lossen.

Mijn excelbestand bevat meerdere tabbladen. Wat ik echter wil is slechts 1 tabblad versturen, het liefst als pdf'je. Enig idee hoe dit moet?

Mvg,

WVE
 
Wat doet ie, als je deze code uitvoert? ( heb geen outlook, dus kan het zelf niet testen. :( )
Code: 
Sub Mail_ActiveSheet()

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

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

    Set Sourcewb = ActiveWorkbook

    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    With Destwb
        If Val(Application.Version) < 12 Then
            
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
           
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
       
        With OutMail
            .to = "ron@debruin.nl"
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add Destwb.FullName
            .Display
        End With
        
        .Close savechanges:=False
    End With


    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 
SjonR zei:
Wat doet ie, als je deze code uitvoert? ( heb geen outlook, dus kan het zelf niet testen. :( )
Code: 
Sub Mail_ActiveSheet()

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

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

    Set Sourcewb = ActiveWorkbook

    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    With Destwb
        If Val(Application.Version) < 12 Then
            
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
           
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
       
        With OutMail
            .to = "ron@debruin.nl"
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add Destwb.FullName
            .Display
        End With
        
        .Close savechanges:=False
    End With


    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
Klik om te vergroten...

Hij pakt nu inderdaad maar 1 tabblad, dat is al een verbetering!

Het is echter nog wel een excelbestand en nog geen pdf :(

Grt
 
Ik kan dat niet voor je realiseren, omdat ik zelf de code niet kan testen. Er komt straks vast nog wel iemand die het wel kan oplossen voor je.
 
Vooruit dan maar;)

Code: 
Sub VenA()
    c00 = "M:\Temp\" & Sheets(1).Name & Format(Now, "yyyymmddhhmm") & ".pdf"
    Sheets(1).ExportAsFixedFormat 0, c00
    With CreateObject("Outlook.Application").CreateItem(0)
        .to = "test@mail.nl"
        .Attachments.Add c00
        .display '.send
    End With
    Kill (c00)
End Sub
 
VenA zei:
Vooruit dan maar;)

Code: 
Sub VenA()
    c00 = "M:\Temp\" & Sheets(1).Name & Format(Now, "yyyymmddhhmm") & ".pdf"
    Sheets(1).ExportAsFixedFormat 0, c00
    With CreateObject("Outlook.Application").CreateItem(0)
        .to = "test@mail.nl"
        .Attachments.Add c00
        .display '.send
    End With
    Kill (c00)
End Sub
Klik om te vergroten...

Bedankt voor de moeite VenA, maar helaas werkt hij niet. In beeld verschijnt:

'Fout 1004 tijdens uitvoering:
Het document is niet opgeslagen. Mogelijk is het document nog geopend of is een fout opgetreden bij het opslaan van het document.'

Als ik naar de foutopsporing ga, wordt het volgende aangegeven:

-> Sheets(1).ExportAsFixedFormat 0, c00

Kan je hier iets mee?

WVE
 
Heb jij een schijf M: met de map Temp op jouw computer?
 
VenA zei:
Heb jij een schijf M: met de map Temp op jouw computer?
Klik om te vergroten...

Het lijkt erop dat ik die niet heb inderdaad. Waar zou ik dat mee moeten vervangen? Met de opslaglocatie van de pdf?

Grt
 
Ik ben er uit gekomen en alles werkt naar wens!

Bedankt voor jullie hulp!

WVE
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan