VBA gmail+bijlage

Status
Niet open voor verdere reacties.

ThijsWezenberg

Nieuwe gebruiker
Lid geworden
21 apr 2021
Berichten
4
Beste allemaal,

Momenteel ben ik bezig met een invulformulier in Word.
Dit formulier is niet zo heel spannend.

Het doel is dat er automatisch vanuit een specifiek Gmail-emailadres naar een ander zakelijk emailadres een mail verzonden wordt, dit is met wat YT tutorials al aardig gelukt.

Ik loop alleen vast op 2 punten.

1. Het lukt mij niet om de het huidige document (invulformulier) als bijlage mee te sturen, dit is wel essentieel. Ik krijg de volgende fout melding: "Het proces heeft geen toegang tot het bestand omdat het door een ander proces wordt gebruikt."

Knipsel.PNG

2. Ik zou graag willen dat het onderwerp van de email als volgt is opgebouwd: Agendapunt "Onderwerp" "Naam Indiener" "Datum van de vergadering"

Deze 3 punten zijn opgenomen als invulveld in het formulier.

Wie o wie kan mij hierbij helpen?

Alvast hartelijk dank!

Code:
Code:
   Dim CDO_Config As Object
   Dim SMTP_Config As Variant
   Dim strSubject As String
   Dim strFrom As String
   Dim strTo As String
   Dim strBody As String
   Dim xDoc As Document
   
   Set xDoc = ActiveDocument
   
   
   strSubject = "Agendapunt"
   strFrom = "EMAILADRES"
   strTo = "EMAILADRES"
   strBody = "Zie bijlage voor het agendapunt. Dit is een automatisch verzonden bericht."
   
   Set CDO_Mail = CreateObject("CDO.Message")
   On Error GoTo error_afhandeling
   
   Set CDO_Config = CreateObject("CDO.Configuration")
   CDO_Config.Load -1
   
   Set SMTP_Config = CDO_Config.fields
   
   With SMTP_Config
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "EMAILADRES"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "WACHTWOORD"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    
    .Update
    
   End With
   
   
   With CDO_Mail
    Set .Configuration = CDO_Config
   End With
   
   
   CDO_Mail.Subject = strSubject
   CDO_Mail.From = strFrom
   CDO_Mail.To = strTo
   CDO_Mail.TextBody = strBody
   CDO_Mail.AddAttachment xDoc.FullName
   CDO_Mail.Send
   
   MsgBox "Het agendapunt is succesvol ingediend.", vbInformation
   
exit_line:
    Set CDO_Mail = Nothing
    Set CDO_Config = Nothing
    
    Exit Sub

error_afhandeling:
    MsgBox "Fout: " & Err.Description, vbInformation
 
Ik sta niet te popelen om je formulier na te bouwen, dus op basis van alleen de code doe ik niks. Misschien iemand anders wel :).
Het eersten punt is simpel op te lossen door het document op te slaan en te sluiten, dan is het prima te mailen.
 
Ik sta niet te popelen om je formulier na te bouwen, dus op basis van alleen de code doe ik niks. Misschien iemand anders wel :).
Het eersten punt is simpel op te lossen door het document op te slaan en te sluiten, dan is het prima te mailen.

Bedankt voor het reageren! Excuses, niet bij stil gestaan. Ik heb het document toegevoegd als bijlage.

Het idee is dat de mail verstuurd wordt door op de "verzend" knop te klikken, dus het bestand eerst opslaan en sluiten werkt dan niet.:)
 

Bijlagen

  • Indienen agendapunt Helpmij.nl.docm
    640,1 KB · Weergaven: 26
Ik zal er vanavond even naar kijken. Ik zie dat je nieuw bent bij HelpMij (nog welkom :)), en dat betekent dus óók dat je de onvermijdelijke fout maakt die echt élke nieuweling blijkbaar móet maken (of de neiging niet kan bedwingen) om de QUOTE knop aan te klikken. Niet meer doen! Dat is namelijk geen antwoordknop. Daarvoor heb je véél betere opties.
 
Dit werkt bij mij, rode tekst toevoegen
Code:
  [COLOR=#FF0000]TempFilePath = Environ$("temp") & "\Copy of " & xDoc.Name

    Application.Documents.Add ActiveDocument.FullName
    ActiveDocument.SaveAs TempFilePath
    ActiveDocument.Close[/COLOR]

    CDO_Mail.Subject = strSubject
    CDO_Mail.From = strFrom
    CDO_Mail.To = strTo
    CDO_Mail.TextBody = strBody
    CDO_Mail.AddAttachment [COLOR=#ff0000]TempFilePath[/COLOR]
    CDO_Mail.Send

    MsgBox "Het agendapunt is succesvol ingediend.", vbInformation

   [COLOR=#FF0000] Kill TempFilePath[/COLOR]

P.S. ik moest mijn gmail veiligheidsinstellingen aanpassen voor "less secure apps access"
 
Laatst bewerkt:
@Alphamax

Enorm bedankt! Het werkt precies zoals ik bedoeld had.

Ik ben dus alleen nog opzoek naar een manier om dus de titel van het document afhankelijk te laten maken van de input in het formulier!
 
Het document wordt nu als bijlage mee verzonden wat helemaal prima is. Het probleem is alleen dat de bijlage als ".docm" wordt verzonden waardoor deze als Malware wordt gezien. Is het ook mogelijk om het document als PDF te versturen?

Ik heb zelf al wat uitgeprobeerd met .ExportAsFixedFormat alleen kom ik er niet helemaal uit hoe ik dit aan de praat krijg.

Hulp hierbij is meer dan welkom.

PS: om het document te kunnen versturen heb ik de aanpassingen van Alphamax gebruikt:
Code:
TempFilePath = Environ$("temp") & "\Copy of " & xDoc.Name

    Application.Documents.Add ActiveDocument.FullName
    ActiveDocument.SaveAs TempFilePath
    ActiveDocument.Close

    CDO_Mail.Subject = strSubject
    CDO_Mail.From = strFrom
    CDO_Mail.To = strTo
    CDO_Mail.TextBody = strBody
    CDO_Mail.AddAttachment TempFilePath
    CDO_Mail.Send

    MsgBox "Het agendapunt is succesvol ingediend.", vbInformation

    Kill TempFilePath
 
Code:
Sub Main()
    For Each oContentControls In ActiveDocument.ContentControls
        MsgBox oContentControls.Range.Text
    Next
End Sub
Hiermee kan je de tekstvakken met opmaak uitlezen.
Je moet wel iets verzinnen waarme je de tekstvakken herkent.
In de eigenschappen van het tekstvak kan "label" een waarde geven, deze kan je uitlezen met
Code:
oContentControls.Tag
 
Laatst bewerkt:
Je gebruikt allemaal ContentControls zonder naam of label. Die moet je dus eerst instellen. Met deze macro kun je ze testen:
Code:
Sub testCC()
Dim cc As ContentControl
Dim i As Integer
    For Each cc In ActiveDocument.ContentControls
        If cc.Title = "" Then
            i = i + 1
            cc.Title = "cc" & i
        End If
        MsgBox cc.Title & vbLf & cc.Tag
    Next cc
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan