automatisch attachments verzenden

[macrodummy]

Hallo,

Ik gebruik een Marco in Word om automatisch enkele honderden mails te versturen met per email een specifiek attachment (Excel bestand). Dit werkte altijd goed, en nu nog steeds, behalve dan dat de macro ermee stopt tussen de 30e en 40e email.
Ik krijg de volgende error: "2147352571, typen komen niet overeen"

Dit is de macro:
Sub emailmergewithattachments()

Dim Source As Document, Maillist As Document, TempDoc As Document
Dim Datarange As Range
Dim i As Long, j As Long
Dim bStarted As Boolean
'Dim oOutlookApp As Outlook.Application
Dim oOutlookApp As Object
'Dim oItem As Outlook.MailItem
Dim oItem As Object
Dim mysubject As String, message As String, title As String

Set Source = ActiveDocument

' Check if Outlook is running. If it is not, start Outlook
'On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If

' Open the catalog mailmerge document
With Dialogs(wdDialogFileOpen)
.Show
End With
Set Maillist = ActiveDocument

' Show an input box asking the user for the subject to be inserted into the email messages
message = "Enter the subject to be used for each email message." ' Set prompt.
title = " Email Subject Input" ' Set title.
' Display message, title
mysubject = InputBox(message, title)

' Iterate through the Sections of the Source document and the rows of the catalog mailmerge document,
' extracting the information to be included in each email.
For j = 1 To Source.Sections.Count - 1
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
.Subject = mysubject
.Body = Source.Sections(j).Range.Text
Set Datarange = Maillist.Tables(1).Cell(j, 1).Range
Datarange.End = Datarange.End - 1
.To = Datarange
For i = 2 To Maillist.Tables(1).Columns.Count
Set Datarange = Maillist.Tables(1).Cell(j, i).Range
Datarange.End = Datarange.End - 1
.Attachments.Add Trim(Datarange.Text), olByValue, 1
Next i
.Send
End With
Set oItem = Nothing
Next j
Maillist.Close wdDoNotSaveChanges

' Close Outlook if it was started by this macro.
If bStarted Then
oOutlookApp.Quit
End If

MsgBox Source.Sections.Count - 1 & " messages have been sent."

'Clean up
Set oOutlookApp = Nothing

End Sub


Als ik foutopsporing doe, dan loopt het vast bij ".To= Datarange".
De eerste 30/40 mails worden goed verstuurd en komen ook aan met attachment.

Ik gebruik outlook 2003 en Word 2007.
Ik gebruik ook het programma Express Click Yes om te omzeilen dat ik per emailtje op 'Ja' moet klikken.


Hopelijk kan iemand mij helpen? Alvast bedankt voor jullie reactie

 

[snb]

Het is voor iedereen prettig als je VBA code tussen VBA code tags zet.

Staan de gegevens voor de emails steeds in een ander bestand ?
Ik zou altijd de voorkeur geven aan een bestand met een vaste naam, waarvan de naam na afloop, indien gewenst, gewijzigd kan worden. Dan is er geen gebruikersaktie nodig tijdens het uitvoeren van de macro.

Dat geldt ook voor het invoeren van een onderwerp: warom zou dat ook niet in het bestand met mailgegevens zijn opgenomen. Hoef je een gebuiker oook niet mee lastig te vallen.

Waarom het misgaat bij een 30e-40e 'record' valt eigenlijk alleen maar te beoordelen als je die records hier plaatst.

Het zou prettig zijn als je een klein stukje van het bestand met de mailgegevens zou kunnen plaatsen.
Ik denk dat je met veel minder en overzichterlijker code toekunt.

Dit is de macro:

Sub simpeler_snb()
  with documents.add("G:\OF\gegevens.doc")
    redim sn (.Sections.Count -1,3)

    For j = 1 To .Sections.Count - 1
      sn(j-1,0)="onderwerp"
      sn(j-1,1)=.Sections(j).Range.Text
      sn(j-1,2)=replace(.Tables(1).Cell(j, 1).Range,chr(7),"")
      for jj= 2 to .tables(1).columns.count
        sn(j-1,3)=sn(j-1,3) & "|" & .tables(1).cells(j,jj).range.Text
      next
    next
    .close 0
  end with

  with createobject("Outlook.application")
    for j=0 to ubound(sn)
      with .CreateItem(olMailItem)
        .Subject = sn(j,0)
        .Body = sn(j,1)
        .To = sn(j,2)
        .Attachments.Add split(sn(j,3),"|")
        .Send
      end With
    next
  end with
End Sub

 

[macrodummy]

sorry voor het weglaten van de tags....
ik gebruik 1 gemerged Word bestand met daarin de tekst die in het mailtje komt (dat is een gepersonaliseerde email). Vervolgens run ik de Marco en dan wordt gevraagd om een inputbestand. Dit inputbestand is ook in Word gemaakt en bevat een tabel met twee kolommen: in de eerste kolom staan de emailadressen en in de tweede kolom het pad waar voor het betreffende emailadres het Excelbestandje (wat als attachment mee moet) staat. Vervolgens type ik 1 keer een onderwerp in, dit is het onderwerp dat alle ontvangers dan te zien krijgen.
Overigens heb ik het nog een paar keer geprobeerd, en nu stopt de Macro na ongeveer 30 mails.
Ik kan helaas de bestanden niet plaatsen omdat deze klantinformatie bevatten.

ik ga even naar je macro kijken in ieder geval

 

[snb]

Alle ontvangers krijgen toch dezelfde tekst uit jouw Wordbestand gestuurd ? Hoezo 'gepersonaliseerd' ?

Om de niet gewenste tekens uit een cel te verwijderen kun je veel eenvoudiger replace(....,chr(7)&chr(10),"") gebruiken dan die moeizame range funktie.
omdat het een tabel is kan het nog veel simpeler:

with documents.add("G:\OF\gegevens.doc")
   sn=split(.tables(1).range,vbcr & chr(7) & vbcr & chr(7)
   .close 0
end with