Access. Specieke bijlagen toevoegen aan verschillende e-mails

[mks]

Hallo. Ik heb in een directory verschillende pdf bestanden staan. Ik wil automatisch na elkaar de bestanden één voor één toevoegen aan afzonderlijke e-mails. Iedere e-mail met één bijlage. Als de eerste e-mail is verstuurd, wordt de volgende klaar gezet/getoond om te verzenden, totdat alle bestanden van de directory zijn verzonden.
Het deel van de code mbt. e-mailen gaat goed als ik een vaste bestandsnaam opgeef

myAttachments.Add "D:\TEST bestanden\jan.pdf"

. Op internet heb ik code gevonden om bestanden na elkaar te kunnen verzenden

myAttachments.Add fl

. Deze code werkt niet goed (fout 438. Deze eigenschap of methode wordt niet ondersteund voor dit object). Moet ik volgens een gelezen artikel in de Microsoft Scripting Runtime Library item "SS - References dialog" aanzetten. Ik kan deze niet in de Library lijst vinden?

Hoe kan ik het oplossen? Hoe ziet de code voor de bestanden eruit?. Bedankt.

Private Sub Knop37_Click()

Dim i As Long
Dim fs, f, f1, fc
Dim Bestand As String
folderspec = "D:\TEST\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files

Dim OutApp As Object
Dim OutMail As Object
Dim myAttachments As Object

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

For Each f1 In fc

With OutMail
    .To = "xxxx@yyyyyyyy.nl"                'email-adressen worden in een volgende stap ook uit de db geautomatiseerd
    .CC = ""
    .BCC = ""
    .Subject = "Status"
    .Body = "Goedendag"
    myAttachments.Add f1
    .display
End With

Set OutMail = Nothing
Set OutApp = Nothing
Set myAttachments = Nothing

Next
End Sub

 

[OctaFish]

Je probleem zit 'm er denk ik in dat je de Set OutMail buiten de loop zet, maar hem binnen de loop verwijdert. Dus bij de eerste mail heb je het object, maar bij de tweede is hij al weg. Objecten continue aan maken en verwijderen binnen een lusroutine vind ik al een beetje onzin, maar op deze manier wordt het wel erg behelpen . De regels Set OutMail = Nothing, Set OutApp = Nothing en Set myAttachments = Nothing zijn sowieso nutteloos omdat dat al gebeurt als de procedure klaar is. Maar goed, het zou dus in de loop zo moeten:

    Set OutApp = CreateObject("Outlook.Application")
    For Each f1 In fc
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "xxxx@yyyyyyyy.nl"                'email-adressen worden in een volgende stap ook uit de db geautomatiseerd
            .CC = ""
            .BCC = ""
            .Subject = "Status"
            .Body = "Goedendag"
            .Attachments.Add f1
            .Display
        End With
    Next

 

[mks]

Dank OctaFish.
Je voorbeeld heb ik getest. Er treedt toch een foutmelding op in de regel <Attachments.Add f1>. (Foutmelding 438. Deze eigenschap of methode wordt niet ondersteund door dit object). Toch de Library?

Dim i As Long
Dim fs, f, f1, fc
Dim Bestand As Long
folderspec = "D:\TEST\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files

Dim OutApp As Object
Dim OutMail As Object
Dim myAttachments As Object


Set OutApp = CreateObject("Outlook.Application")

For Each f1 In fc
Set OutMail = OutApp.CreateItem(0)
                                                          'Set myAttachments = OutMail.Attachments
With OutMail
    .To = "xxxx@yyyyyy.nl"
    .CC = ""
    .BCC = ""
    .Subject = "Status"
    .Body ="Goedendag"
    .Attachments.Add f1
    .display
End With
   Next
End Sub

 

[snb]

Private Sub Knop37_Click()
  c00 = "D:\TEST\"
  c01 =dir(c00 & "*.PDF")
  if c01="" then exit sub
  
  with CreateObject("Outlook.Application")
     do until c01 =""  
       with .CreateItem(0)
         .To = "xxxx@yyyyyyyy.nl"
         .Subject = "voorbeeld"
         .Body = "geen"
         .attachments.Add c00 & c01
         .send
      End With

      c01=dir
    loop
  End with
End Sub

 

[mks]

SNB bedankt, fantastisch, een code met minder omhaal dan de mijne maar toch nog een probleem geconstateerd. Ik heb het e-mail adres ook dynamisch gemaakt door destillatie van de bedrijfsnaam uit de bestandsnaam en vervolgens met DLookUp etc. het bijbehorende emailadres bij de bijlage uit de tabel kan worden opgehaald.

Het blijkt toch dat er een foutmelding (Fout 462. Remote server not found) optreedt wanneer de code de derde keer (van de 24) een email aanmaakt. Het is vreemd omdat het emailadres en de bijlage, van de foute email, klopt en dezelfde procedure wordt doorlopen en toch de error handler wordt aangesproken. Op internet vind ik het volgende document: https://anictteacher.files.wordpress.com/2011/11/vba-error-462-explained-and-resolved.pdf . Maar wat zou ik dan moeten aanpassen in mijn code.

 

[snb]

Toon svp de code waarmee je het emailadres 'dynamisch' hebt gemaakt.

 

[mks]

Dank dat je helpt.
Ik heb drie testknoppen om de verschillende delen van de code te kunnen testen. Er staan vier testbestanden in de directory klaar voor verzending. Bij de code zonder het bepalen van het emailadres krijg ik in de regel < With .CreateItem(0) > m.n. CreateItem de fout "Compileerfout. Ongeldige of niet gekwalificeerde verwijzing". Voeg ik de coderegels voor het bepalen van het emailadres er bij, code LEN, DLookUp, dan gaan de eerste twee emails goed en de volgende fout en krijg ik "foutmelding 94 tijdens uitvoering. Ongeldig gebruik van nul" en staat de debuggerregel in Rst = DLookup("m_email", "Bedrijven", "m_Naam = '" & BstName & "'") Het heeft tot nu goed gewerkt totdat ik fout 462 kreeg toen ik alle bestanden op de directory wou doorlopen. Hoe los ik ook deze fout op?

Private Sub Knop38_Click()
Dim c00 As String
Dim c01 As String
Dim LenName As Long
Dim BstName As String                       'Gedestileerde bestandsnaam
Dim Rst As String
c00 = "D:\TEST\"                     'PAD VERKENNER waar pdf bestanden  - Bedrijven -  staan
  c01 = Dir(c00 & "*.PDF")
  If c01 = "" Then Exit Sub
  
  With CreateObject("Outlook.Application")
     Do Until c01 = ""
     LenName = Len([c01])                         'Lengte bepalen bestandsnaam bijlage
     LenName = LenName - 4                      'Aantal karaters van de bestandsnaam zonder extentie .pdf
     BstName = Left([c01], LenName)         'Gedestileerde bedrijfsnaam uit de bestandsnaam
     Rst = DLookup("b_email", "Bedrijven", "b_Naam = '" & BstName & "'")   'Haalt uit de tabel het emailadres op behorende bij de bedrijfsnaam      [COLOR="#FF0000"]'foutmelding 94. Ongeldig gebruik van nul[/COLOR]

       With .CreateItem(0)                                                                                                                          [COLOR="#FF0000"]'Compileerfout. Ongeldige of niet gekwalificeerde verwijzing[/COLOR]
         .To = Rst
         .Subject = "voorbeeld"
         .Body = "geen"
         .attachments.Add c00 & c01         'voeg bijlage bestand vanaf directory toe
         .display
         '.send                             'automatisch verzenden is uitgeschakeld
      End With

      c01 = Dir                                                                                                                                     [COLOR="#FF0000"]'Waar is deze regel voor??[/COLOR]
    Loop
  End With

End Sub

 

[snb]

Het gaat natuurlijk om de funktie dLookup.
Plaats die svp hier.
Het lijkt alsof er een fout in je data zit.
Als een bedrijf niet wordt gevonden loopt de code natuurlijk in de soep.

Private Sub Knop38_Click()
  c00 = "D:\TEST\" 
  c01 = Dir(c00 & "*.PDF")
  If c01 = "" Then Exit Sub
  
  With CreateObject("Outlook.Application")
     Do Until c01 = ""
       msgbox replace(c01,".pdf","")
       msgbox  DLookup("b_email", "Bedrijven", "b_Naam = '" & replace(c01,".pdf","'"))

       With .CreateItem(0) 
         .To = Rst
         .Subject = "voorbeeld"
         .Body = "geen"
         .attachments.Add c00 & c01
         .display
         '.send 
      End With

      c01 = Dir                                                                                                                                     'Waar is deze regel voor??
    Loop
  End With

End Sub

 

[OctaFish]

Waarom zo riskant het email opgehaald?

            Rst = DLookup("b_email", "Bedrijven", "b_Naam = """ & BstName & """")

 

[mks]

Dank voor jullie hulp, veel aan gehad. De aangeleverde vitaminen hebben kennelijk hun uitwerking op het programma gehad. SNB je had gelijk, één emailadres was er niet. Met het vele testen en problemen zie je soms de bomen in het bos niet meer, zo ook in dit geval en ondanks de controles. Eea. aangepast en het programma loopt en tot nog toe en alle foutmeldingen zijn weg. De e-mails worden na elkaar zonder problemen aangemaakt en kunnen worden geannuleerd of verzonden.

OctaFish. Het programma lijkt inderdaad een beetje "krom". In de tabel staan bedrijfsnamen en de email-adressen. De bestandsnamen (zonder extensie pdf) zijn 100% gegarandeerd gelijk aan de bedrijfsnamen. Ik zag geen andere manier om van de bestandsnaam via de bedrijfsnaam het overeenkomstige e-mailadres in de tabel te destilleren. Er moet wel zekerheid zijn dat alle e-mailadressen in de tabel beschikbaar zijn, maar dat is op te lossen.

 

[snb]

Private Sub Knop38_Click()
  on error resume next
  c00 = "D:\TEST\" 
  c01 = Dir(c00 & "*.PDF")
  If c01 = "" Then Exit Sub
  
  With CreateObject("Outlook.Application")
     Do Until c01 = ""
       With .CreateItem(0) 
         .To = DLookup("b_email", "Bedrijven", "b_Naam = '" & replace(c01,".pdf","'"))
         if err.number=0 then 
           .Subject = "voorbeeld"
           .Body = "geen"
           .attachments.Add c00 & c01
           .send 
         end if
         err.clear
      End With

      c01 = Dir                                                                                                                                     'Waar is deze regel voor??
    Loop
  End With

End Sub

 

[OctaFish]

Ik blijf het een nodeloos ingewikkelde oplossing vinden. Zelf sla ik documenten die vanuit de database gegenereerd worden op in een documententabel, dus inclusief pad en bestandsnaam. Een mailing genereer je dan m.b.v. een query waarin je filtert op e-mail adressen (raar dat je dat al niet gedaan had, ik ging er eigenlijk vanuit dat je dat deel wel had maar niet meegepost had). In de mailprocedure haal je dan de documenten op uit je tabel. Nooit problemen mee. Bovendien weet je dan ook wanneer een mailing is gemaakt etc, dus vanuit documentbeheer oogpunt kun je veel meer vastleggen.