• 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.

Door op Button te drukken automatisch 1 sheet in pdf formaat mailen

Status
Niet open voor verdere reacties.
M

MauriceD

Gebruiker
Lid geworden
15 apr 2017
Berichten
48
Goedemorgen,

Ik heb een vraag aan jullie.
Probeer al een tijd om een PDF bestand als bijlage te versturen in outlook (1 sheet)
Het lukt me niet en ook op de site van Ron de Bruin kom ik niet wijzer uit.

Dit is de code die ik nu heb en werkt gewoon goed. Alleen is het het gehele excel bestand. dus ook de sheets plus data etc.



Sub send_mail()
'
' Macro5 Marco
'

Application.DisplayAlerts = False

Dim Country As Integer, result As String
Country = Range("I1").Value

x = Range("c12")

y = Range("c11")


Dim Lo As ListObject
Dim r As Range
Dim oApp As New Outlook.Application
Dim oMail As Outlook.MailItem
With CreateObject("Outlook.Application").CreateItem(0)


'The Netherlands.

If Country = 1 Then
.To = "email adres"
.CC = "email adres ; email adres"
.Subject = y & " " & x
.Body = "In de bijlage een filiaalmelding. Vragen over deze melding kun je contact op nemen met DC-A Site Security. Met vriendelijke groet"
.Attachments.Add ThisWorkbook.FullName
.Display
.Send
MsgBox ("E-mail is verstuurd")
End If

'Belgium.

If Country = 2 Then
.To = "email adres ; email adres "
.CC = "email adres ; email adres"
.Subject = y & " " & x
.Body = "In the appendix the new store notification. Any questions about this info, You can contact site security. Met vriendelijke groet"
.Attachments.Add ThisWorkbook.FullName
.Send
MsgBox ("E-mail is verstuurd")
End If

'Germany.

If Country = 3 Then
.To = "email adres ; email adres"
.CC = "email adres ; email adres"
.Subject = y & " " & x
.Body = "In the appendix the new store notification. Any questions about this info, You can contact site security. Mit freundlichen Grüßen"
.Attachments.Add ThisWorkbook.FullName
.Send
MsgBox ("E-mail is verstuurd")
End If

'France.

If Country = 4 Then
.To = "email adres ; email adres"
.CC = "email adres ; email adres"
.Subject = y & " " & x
.Body = "In the appendix the new store notification. Any questions about this info, You can contact site security. "
.Attachments.Add ThisWorkbook.FullName
.Send
MsgBox ("E-mail is verstuurd")
End If

'Luxembourgh.

If Country = 5 Then
.To = "email adres"
.CC = "email adres; email adres"
.Subject = y & " " & x
.Body = "In the appendix the new store notification. Any questions about this info, You can contact site security"
.Attachments.Add ThisWorkbook.FullName
.Send
MsgBox ("E-mail is verstuurd")
End If

'Austria.

If Country = 7 Then
.To = "email adres ; email adres"
.CC = "email adres ; email adres"
.Subject = y & " " & x
.Body = "In the appendix the new store notification. Any questions about this info, You can contact site security"
.Attachments.Add ThisWorkbook.FullName
.Send
MsgBox ("E-mail is verstuurd")
End If

'Poland.

If Country = 8 Then
.To = "Email adres"
.CC = "Email adres; Email adres"
.Subject = y & " " & x
.Body = "In the appendix the new store notification. Any questions about this info, You can contact site security"
.Attachments.Add ThisWorkbook.FullName
.Send
MsgBox ("E-mail is verstuurd")
End If


End With
'
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub



Alvast bedankt!
Gr,
Maurice
 
Probeer het eens zo:
Code: 
Sub send_mail()
    msgNLD = "In de bijlage een filiaalmelding." & vbCrLf & _
             "Vragen over deze melding kun je contact op nemen met DC-A Site Security." & vbCrLf & vbCrLf & _
             "Met vriendelijke groet"
             
    msgENG = "In the appendix the new store notification." & vbCrLf & _
             "For any questions about this info you can contact site security." & vbCrLf & vbCrLf & _
             "Kind regards"
             
    sSubject = Range("C11") & " " & Range("C12")
    Select Case Range("I1").Value [COLOR="#008000"]'Country[/COLOR]
        Case 1:     sBody = msgNLD
        Case Else:  sBody = msgENG
    End Select

    sPDF = Environ("temp") & "\temp.pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPDF

    On Error Resume Next
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "Email adres"
        .CC = "Email adres; Email adres"
        .Subject = sSubject
        .Body = sBody
        .Attachments.Add sPDF
        .Display [COLOR="#008000"]' of .Send[/COLOR]
    End With

    If Err.Number = 0 Then
        MsgBox ("E-mail is verstuurd")
    Else
        MsgBox Err.Description, vbCritical, "Fout: " & Err.Number
    End If

    Kill sPDF
End Sub
 
Laatst bewerkt:
Goedemiddag edmoor,
Ga dit vannacht even proberen! Bedankt. Was vergeten te melden dat bij elk land een ander email adres gebruikt wordt. Kan dit ook met bovenstaande code?

Gr,
Maurice
 
Uiteraard kan dat.
Daar kan je dezelfde methodes voor gebruiken.

Zoals dit:
Code: 
Sub send_mail()
    msgNLD = "In de bijlage een filiaalmelding." & vbCrLf & _
             "Vragen over deze melding kun je contact op nemen met DC-A Site Security." & vbCrLf & vbCrLf & _
             "Met vriendelijke groet"
             
    msgENG = "In the appendix the new store notification." & vbCrLf & _
             "For any questions about this info you can contact site security." & vbCrLf & vbCrLf & _
             "Kind regards"
             
    sSubject = Range("C11") & " " & Range("C12")
    Select Case Range("I1").Value [COLOR="#008000"]'Country[/COLOR]
        [COLOR="#008000"]'The Netherlands.[/COLOR]
        Case 1:  sBody = msgNLD: sTO = "Email adres": sCC = "Email adres;Email adres"
        [COLOR="#008000"]'Belgium.[/COLOR]
        Case 2:  sBody = msgENG: sTO = "Email adres": sCC = "Email adres;Email adres"
        [COLOR="#008000"]'Germany.[/COLOR]
        Case 3:  sBody = msgENG: sTO = "Email adres": sCC = "Email adres;Email adres"
        [COLOR="#008000"]'France.[/COLOR]
        Case 4:  sBody = msgENG: sTO = "Email adres": sCC = "Email adres;Email adres"
        [COLOR="#008000"]'Luxembourgh.[/COLOR]
        Case 5:  sBody = msgENG: sTO = "Email adres": sCC = "Email adres;Email adres"
        [COLOR="#008000"]'Austria.[/COLOR]
        Case 7:  sBody = msgENG: sTO = "Email adres": sCC = "Email adres;Email adres"
        [COLOR="#008000"]'Poland.[/COLOR]
        Case 8:  sBody = msgENG: sTO = "Email adres": sCC = "Email adres;Email adres"
    End Select

    sPDF = Environ("temp") & "\temp.pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPDF

    On Error Resume Next
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = sTO
        .CC = sCC
        .Subject = sSubject
        .Body = sBody
        .Attachments.Add sPDF
        .Display [COLOR="#008000"]'of .Send[/COLOR]
    End With

    If Err.Number = 0 Then
        MsgBox ("E-mail is verstuurd")
    Else
        MsgBox Err.Description, vbCritical, "Fout: " & Err.Number
    End If

    Kill sPDF
End Sub
 
Laatst bewerkt:
Edmoor,

Je bent geweldig!
Hij pakte de code in 1 keer..
In mijn vorige code werd het excel bestand (Nu pdf) automatisch van een naam voorzien. Nu heet het bestand bijv. altijd temp.pdf
Hoe zou ik dit kunnen veranderen in de code.

Dit maakte het onderwerp toen;

x = Range("c12")

y = Range("c11")

Gr,
Maurice
 
Dat zou je in de code al wel kunnen zien. Ik weet natuurlijk niet wat er in C11 en C12 staat, maar probeer dit eens:
Code: 
sPDF = Environ("temp") & "\" & Range("C11") & Range("C12")
 
Goedenavond,

Heb het aangepast en de door u gegeven code stuurt dan geen bijlage meer mee.
In de aangegeven cellen staat het filiaalnummer en filiaalnaam.

Het zelfde dus eigenlijk als het onderwerp van het mailtje. Wat wel heel goed werkt!

Gr,
Maurice
 
Ik moet dus letterlijk weten wat er in die cellen staat. Als daar tekens in staan die niet in een bestandsnaam voor mogen komen zal dat inderdaad fout gaan.
Plaats je document.
 
Laatst bewerkt:
Doet het hier prima, zonder enige wijziging.
De PDF naam heb je zelf al opgegeven als Store Notification.
 
edmoor zei:
Doet het hier prima, zonder enige wijziging.
De PDF naam heb je zelf al opgegeven als Store Notification.
Klik om te vergroten...

Edmoor, dat heb ik inderdaad zelf aangepast ipv. Temp. Automatisch de filiaalnaam en het filiaalnummer doet die er niet mee.

Ben hier al tevreden over hoor, het zou het alleen af maken ;)
 
Store Notification FILIAAL NR FILIAAL NAAM.
Als dat mogelijk is.

Gr,
Maurice
 
Ok. Doe het zo:
Code: 
sPDF = Environ("temp") & "\Store Notification " & sSubject & ".pdf"
 
Edmoor, je bent de beste!
Nu heb ik vannacht heel wat gegoogled om het volgende voor elkaar te krijgen...

Gaat om het dubbel klikken, gebruik nu de volgende code;

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("D:D")) Is Nothing Then
Cancel = True
Target.Copy
Sheets("Mail").Range("C11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Mail").Select

End If
End Sub

Deze code pakt alleen de gegevens van Rij D als je hier 2 keer opklikt en komt dan in sheet "mail" in cel C11.

Dit werkt gewoon!
Maar wil graag ook dat dan de gegevens van kolom G naar sheet "mail" gaat in cel C13.

Veel tegen gekomen maar niet een code om 2 cellen mee te nemen naar een andere sheet.

Is dit te doen?

Gr,
Maurice
 
Test deze eens:
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 4 Then
        With Sheets("Mail")
            .Range("C11") = Target.Value
            .Range("C13") = Range("G" & Target.Row).Value
            .Select
        End With
        Cancel = True
    End If
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan