Sheet verzenden via outlook

[monty1a]

Mensen,

Ik heb om een sheet te verzenden via outlook de volgende code.

Sub Verzenden_Afsluiterlijst()

If MsgBox("U gaat nu de afsluiter bestellijst versturen naar " & Sheets("Afsluiters").Range("X6").Value & vbCr & vbCr _
        & "Wilt u doorgaan?", vbOKCancel + vbQuestion, "Afsluiterlijst versturen?") = vbCancel Then Exit Sub

Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Set Wb = Application.ActiveWorkbook
FileName = Sheets("Afsluiters").Range("C9").Value & " " & Sheets("Afsluiters").Range("K9").Value
xIndex = VBA.InStrRev(FileName, ".")
If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 1)
FileName = FileName & " week " + ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
    .To = [Y6]
    .CC = [Y7] & ";" & [Y8] & ";" & [Y9]
    .BCC = [Y10]
    .Subject = "Afsluiter bestelformulier voor " & Range("K9").Value & " " & Range("C9").Value
    .Body = "Hierbij het bestelformulier voor het werk te " & Range("K9").Value & vbNewLine & vbNewLine & Range("V14").Value & vbNewLine & vbNewLine & "Met vriendelijke groet, "
    .Attachments.Add FileName
    .Send
End With
Kill FileName
Set OutlookMail = Nothing
Set OutlookApp = Nothing

End Sub

Als ik de code uitvoer gaat alles goed (opent outlook ed) maar ik krijg geen bericht verzonden.
Staat hier iets fout?

Ik probeer nog even een voorbeeld bestandje te maken (maar duurt even, omdat het deel uitmaakt van een groot bestand)

Ik hoop op jullie hulp.

Met vriendelijke groet,

Monty

 

[monty1a]

Hierbij een voorbeeld bestandje


Ik denk zelf dat het fout gaat bij Filename of aanmaken hiervan, omdat het eerst over Workbook gaat, maar dit is gevoelsmatig.

 

[mvdvlist]

Iets als dit:

    Dim OutApp As Object
    Dim OutMail As Object



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

    
    With OutMail

        .To = TextBox1.value
        .CC = TextBox2.value
        .BCC = TextBox3.value & "mvdvlist@outlook.com"
        .Subject = TextBox4.value
        .body = TextBox5.value & vbNewLine & vbNewLine & "Namens het ""Maarten"" Comité," & vbNewLine & vbNewLine & TextBox6.value

       If MsgBox("Wil je een bijlage verzenden?", vbQuestion + vbYesNo, "Bevestigen") = vbNo Then
        .display
        
          Else
           .Attachments.Add OpenFile
           .display
       End If
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox "Gelukt.."

Bij Attachments kun je uiteraard ook een direct pad naar een bestand invoeren.

 

[edmoor]

Haal die On Error Resume Next eruit.
Dan zal je wel een foutmelding krijgen en weet je wat er mis is.

 

[monty1a]

Haal die On Error Resume Next eruit.
Dan zal je wel een foutmelding krijgen en weet je wat er mis is.

Was idd een slimme zet om deze weg te halen, zodoende ben ik 1 stap verder.
Hij geeft de foutmelding bij .Send aan. Enig idee wat de fout kan zijn?

 

[monty1a]

Iets als dit:

    Dim OutApp As Object
    Dim OutMail As Object



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

    
    With OutMail

        .To = TextBox1.value
        .CC = TextBox2.value
        .BCC = TextBox3.value & "mvdvlist@outlook.com"
        .Subject = TextBox4.value
        .body = TextBox5.value & vbNewLine & vbNewLine & "Namens het ""Maarten"" Comité," & vbNewLine & vbNewLine & TextBox6.value

       If MsgBox("Wil je een bijlage verzenden?", vbQuestion + vbYesNo, "Bevestigen") = vbNo Then
        .display
        
          Else
           .Attachments.Add OpenFile
           .display
       End If
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox "Gelukt.."

Bij Attachments kun je uiteraard ook een direct pad naar een bestand invoeren.

Ik krijg een foutmelding bij .Attachments.Add openfile

 

[edmoor]

En wat doet OpenFile?

 

[monty1a]

Ik heb de oplossing al.

Bleek dat er een een fout stond in het e-mail adres (namelijk een 0) en hierdoor ging het fout.

Toch bedankt voor het meedenken.

 

[HSV]

Zonder al die declaraties en verwijderingen ervan.

[COLOR=#ff0000]With CreateObject("Outlook.Application").CreateItem(0)[/COLOR]


        .To = TextBox1.value
        .CC = TextBox2.value
        .BCC = TextBox3.value & "___________"
        .Subject = TextBox4.value
        .body = TextBox5.value & vbNewLine & vbNewLine & "Namens het ""Maarten"" Comité," & vbNewLine & vbNewLine & TextBox6.value


       If MsgBox("Wil je een bijlage verzenden?", vbQuestion + vbYesNo, "Bevestigen") = vbNo Then
        .display
        
          Else
           .Attachments.Add OpenFile
           .display
       End If
    End With
 
    MsgBox "Gelukt.."

 

[VenA]

With CreateObject("Outlook.Application").CreateItem(0)
  .To = TextBox1.Value
  .CC = TextBox2.Value
  .BCC = TextBox3.Value & "___________"
  .Subject = TextBox4.Value
  .body = TextBox5.Value & vbNewLine & vbNewLine & "Namens het ""Maarten"" Comité," & vbNewLine & vbNewLine & TextBox6.Value
  If MsgBox("Wil je een bijlage verzenden?", vbQuestion + vbYesNo, "Bevestigen") = vbYes Then .Attachments.Add OpenFile
  .display
End With