Macro excel: Tekst in body van mail niet altijd mee.

[pimjansen]

Goedemorgen allen,

Mijn probleem is als volgt: Ik heb een macro gemaakt waarin er automatisch mails worden gestuurd naar klanten, met als bijlage een ondertekende pakbon. Dit zijn PDF-files die excel uit een map haalt. Mijn probleem is alleen als volgt: bij de debiteur die bovenaan in het bestand staat (bovenste regel) wordt het bestand wel bijgevoegd, maar is er geen body (dus geen tekst in de mail). Terwijl dat bij alle andere debiteuren wel gebeurd. Het is niet afhankelijk van de debiteur, want het is een bestand dat ververst wordt en het gebeurt altijd bij de bovenste.

Iemand een oplossing?

 

[ReneDirks]

Dan zal er wel iets in de macro niet goed zitten. Maar omdat die hier niet staat kunnen we daar niet veel mee...

 

[pimjansen]

je hebt gelijk

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

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

Set sh = Sheets("Bron")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("D1:E1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.Subject = "Pakbon bij factuur:" & cell.Offset(0, -1).Value
Dim strbody As String
.Body = strbody
strbody = "Geacht heer / mevrouw," & vbNewLine & vbNewLine & _
"Hierbij de pakbon bij de factuur die u eerder heeft ontvangen." & vbNewLine & _
" " & vbNewLine & _
"Met vriendelijke groet," & vbNewLine & _
" " & vbNewLine & _
"Tibuplast"

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Display 'Or use Send
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Dat is m

 

[ReneDirks]

Daar zit ie dus al:

Dim strbody As String
.Body = strbody
strbody = "Geacht heer / mevrouw," & vbNewLine & vbNewLine & _

Eerst declareer je de var, da's goed, dan ken je de LEGE var toe aan de Body, en dan geef je de var een waarde. Dat moet dus andersom

Dim strbody As String
strbody = "Geacht heer / mevrouw," & vbNewLine & vbNewLine & _
.Body = strbody

Omdat dit een constante tekst is hoef je deze waarde ook echt niet iedere keer in de loop toe te kennen hoor, dus kun je boven de loop laten

 

[pimjansen]

Dank wederom voor de snelle reactie! Enorm fijn!

Je wijst me op een fout, maar ik weet nog niet direct wat ik ervan moet maken.
Dit heeft er hoogst waarschijnlijk mee te maken dat ik weinig verstand heb van VBA. Ik kopieer en plak meestal.

De tekst die ik graag wil maken is:
Geachte heer / mevrouw,

Hierbij de pakbon bij de factuur die u eerder heeft ontvangen.

Met vriendelijke groet,

Tibuplast B.V.

Hoe kan ik de macro zo inrichten dat dit er komt?

 

[ReneDirks]

Dat komt er nu ook wel (in de versie die ik gepost had). Het probleem is dat je eerst aan de (Outmail).Body de waarde van de variabele strBody toekent, maar die is op dat moment nog leeg. Vervolgens ken je een waarde toe aan de variabele strBody, maar die geef je niet meer aan de (Outmail).Body. In de volgende loop heeft strBody nog steeds dezelfde waarde - deze verandert immers niet en ken je deze opnieuw toe aan (Outmail).Body. Nú krijgt de mail wel een waarde en vanaf dat moment gaat het goed. Daarom gaat jouw eerste record/mail fout en de rest goed.
Ik zal zo even de complete code posten, ik ga deze verder niet opschonen, dat mag je zelf een keer doen

 

[ReneDirks]

Zoals gezegd:

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim strBody as string
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Bron")
    Set OutApp = CreateObject("Outlook.Application")

    strbody = "Geacht heer / mevrouw," & vbNewLine & vbNewLine & _
            "Hierbij de pakbon bij de factuur die u eerder heeft ontvangen." & vbNewLine & _
            " " & vbNewLine & _
            "Met vriendelijke groet," & vbNewLine & _
            " " & vbNewLine & _
            "Tibuplast"


    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        'Enter the path/file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("D1:E1")
        If cell.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .to = cell.Value
                .Subject = "Pakbon bij factuur:" & cell.Offset(0, -1).Value
                .Body = strbody

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Display 'Or use Send
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

[pimjansen]

Dit is fantastisch! Werkt precies zoals ik wilde.

Bedankt!

 

[ReneDirks]

Hopelijk snap je ook wat er nu fout was?

 

[snb]

of

Sub M_snb()
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
 
    c00 = replace("Geachte heer / mevrouw,~~Hierbij de pakbon bij de factuur die u eerder heeft ontvangen.~~Met vriendelijke groet,~~Tibuplast","~"vblf)
    sn=Sheets("Bron").cells(1).currentregion

    with CreateObject("Outlook.Application")
      for j=2 to ubound(sn)
        if instr(sn(j,2),"@")>0 and sn(j,4)&sn(j,5)<>"" Then
          with .CreateItem(0)
            .to = sn(j,2)
            .Subject = "Pakbon bij factuur:" & sn(j,1)
            .Body = c00
            if dir(sn(j,4))<>"" then attachments.add sn(j,4)
            if dir(sn(j,5))<>"" then attachments.add sn(j,5)
            .Send
          End With
        End If
      Next
    end with

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

 

[Warme bakkertje]

1 klein mankementje

c00 = replace("Geachte heer / mevrouw,~~Hierbij de pakbon bij de factuur die u eerder heeft ontvangen.~~Met vriendelijke groet,~~Tibuplast","~"[COLOR="#FF0000"],[/COLOR]vblf)

 

[pimjansen]

Ik denk dat ik het wel begrijp ja.
Nogmaals dank