Handtekening in email via Access

Status
Niet open voor verdere reacties.
W

Wonkjz

Gebruiker
Lid geworden
1 mrt 2012
Berichten
42
Dag allen,

Ik moet in Access via een knop "Send email" ervoor zorgen dat Outlook opent, en dat de handtekening er dan automatisch in staat.
Daarvoor heb ik al veel gezocht op internet, en vond ik de onderstaande code van Ron de Bruin. Daarover heb ik een aantal vraagjes.

De functie GetBoiler, waar komt die te staan? Komt die gewoon boven de code van de button? Of staat deze apart? Als ik de code zo erin zet
en ik klik op "Send email", dan gebeurd er niks. Zie ik iets over het hoofd, of staat de code gewoon niet goed?


Ik ben niet zo'n ster hierin, dus ik hoop dat iemand mij hiermee kan helpen.

Mijn dank is groot.

Met vriendelijke groet,



Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

Sub Knop160_Click()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2010
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String

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

strbody = "<H3><B>Dear Customer</B></H3>" & _
"Please visit this website to download the new version.<br>" & _
"Let me know if you have problems.<br>" & _
"<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
"<br><br><B>Thank you</B>"

'Use the second SigString if you use Vista or win 7 as operating system


SigString = "C:\Users\gebruikersnaam\AppData\Roaming\Microsoft\Templates\Tester.oft"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next
With OutMail
.To = "eigen emailadres"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = strbody & "<br><br>" & Signature
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
 
Allereerst welkom op het forum! VBA code wordt er een stuk leesbaarder op als je die opmaakt met de CODE tag. Daar is een aparte knop voor ( # ) dus als je dat alsnog zou willen doen, dan graag! Kijken wij ondertussen naar de code ;)
 
Dank u voor het welkomen! :)

Mijn excuses, heb het hieronder nu aangepast.

Alvast bedankt,

Mvg,


Code: 
Function GetBoiler(ByVal sFile As String) As String
 'Dick Kusleika
 Dim fso As Object
 Dim ts As Object
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
 GetBoiler = ts.readall
 ts.Close
 End Function
 
Sub Knop160_Click()
 ' Don't forget to copy the function GetBoiler in the module.
 ' Working in Office 2000-2010
 Dim OutApp As Object
 Dim OutMail As Object
 Dim strbody As String
 Dim SigString As String
 Dim Signature As String
 
Set OutApp = CreateObject("Outlook.Application")
 Set OutMail = OutApp.CreateItem(0)
 
strbody = "<H3><B>Dear Customer</B></H3>" & _
 "Please visit this website to download the new version.<br>" & _
 "Let me know if you have problems.<br>" & _
 "<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
 "<br><br><B>Thank you</B>"
 
'Use the second SigString if you use Vista or win 7 as operating system
 

SigString = "C:\Users\gebruikersnaam\AppData\Roaming\Microsoft\Templates\Tester.oft"
 
If Dir(SigString) <> "" Then
 Signature = GetBoiler(SigString)
 Else
 Signature = ""
 End If
 
On Error Resume Next
 With OutMail
 .To = "eigen emailadres"
 .CC = ""
 .BCC = ""
 .Subject = "This is the Subject line"
 .HTMLBody = strbody & "<br><br>" & Signature
 'You can add files also like this
 '.Attachments.Add ("C:\test.txt")
 .Send 'or use .Display
 End With
 
On Error GoTo 0
 Set OutMail = Nothing
 Set OutApp = Nothing
 End Sub
 
De functie GetBoiler kun je overal neerzetten; het mooist is een aparte module en dus niet op de codepagina van je formulier. In het laatste geval werkt de code alleen op het formulier; maak je een aparte module, of zet je de functie in een reeds bestaande module, dan kun je hem overal aanroepen.

De reden dat de code niet werkt, is vermoedelijk omdat je het OFT bestand niet hebt. Met de string "C:\Users\gebruikersnaam\AppData\Roaming\Microsoft\Templates\Tester.oft" wordt een specifiek bestand opgeroepen. Ik heb de pagina waar je de code vandaan hebt nog niet bekeken (is wel handig als je daar de link van meepost), maar ik vermoed dat je naar een ander bestand moet verwijzen.
 
Oke, dan zal ik die functie apart in een module neerzetten.

Ik heb de code van deze website: http://www.rondebruin.nl/mail/folder3/signature.htm
Daarop staan ook andere bestandindelingen, en geen .oft.

"If you create a signature in Outlook it will save three files (HTM, TXT and RTF)".

Maar als ik een signature aanmaak in Outlook, dan zou ik dat bestand dus een andere indeling moeten geven?

Met vriendelijke groet,

Ik heb het nu aangepast naar een .txt file, en dit schijnt te werken. De mails worden verstuurd en deze ontvang ik.
Alleen opent Outlook zich nu niet, als ik vanuit Access op "Send email" klik. De gebruiker zou wel het mailtje zullen moeten kunnen typen..
 
Laatst bewerkt:
Handtekeningen worden vanzelf aangemaakt en opgeslagen; daar kun je helemaal niks aandoen. Een oft bestand is een sjabloon, en in ieder geval geen handtekening. Dus dat kun je al niet gebruiken.
Verder zit er een 'foutje' in de code van Ron: hij is geënt op de Engelstalige markt. In Nederlandse Windows versies heet de map Handtekeningen. Je moet dus in ieder geval deze string gebruiken:
Code: 
    SigString = Environ("AppData") & "\Microsoft\Handtekeningen\Michel Nieuw.txt"

Deze variant werkt in ieder geval:
Code: 
Sub Mail_Outlook_With_Signature_Plain()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2010
Dim strbody As String
Dim SigString As String
Dim Signature As String

'-----------------------------------------------------------
'Late binding optie
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem
''    Set OutApp = CreateObject("Outlook.Application")
''    Set OutMail = OutApp.CreateItem(0)
'-----------------------------------------------------------

'-----------------------------------------------------------
'Early Binding optie, met Outlook bibliotheek geladen
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
    Set OutApp = New Outlook.Application
    Set OutMail = OutApp.CreateItem(olMailItem)
'-----------------------------------------------------------

    strbody = "Hi there" & vbNewLine & vbNewLine & "This is line 1" & vbCrLf & "This is line 2" & vbCrLf _
              & "This is line 3" & vbNewLine & "This is line 4"

    'Change only Mysig.txt to the name of your signature
    SigString = Environ("AppData") & "\Microsoft\Handtekeningen\Michel Nieuw.txt"
    
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody & vbNewLine & vbNewLine & Signature
        'You can add files also like this
        '.Attachments.Add ("C:\test.txt")
        .Display
        ''.Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Als ik uw code gebruik en erin plak, dan verander ik de naam van mijn knop zoals die is, namelijk: Sub Knop160_Click().
Maakt dit wat uit verder?
Ik daarna de
Code: 
SigString = Environ("AppData") & "\Microsoft\Handtekeningen\Test2.txt"
aangepast.

Als ik daarna in "form" view op de knop klik, dan verschijnt de volgende melding:
Compile error: User-defined typ not defined.

Waar ligt dit aan?

Alvast bedankt voor de genomen moeite.

Met vriendelijke groet,
 
Mijn voorbeeldje is gebaseerd op Early Binding, d.w.z. dat je in je bibliotheken de Outlook bibliotheek hebt toegevoegd aan de verwijzingen. Heb je dat niet gedaan, dan zou ik de Late Binding variant gebruiken. Nu ik je eigen code heb teruggelezen, is dat ook het geval. Dus ofwel de Outlook bibliotheek toevoegen, ofwel de Late Binding variant activeren, en de Early Binding code omzetten naar Commentaar, of verwijderen.
 
Ik heb de onderstaande code erin staan, maar krijg nog steeds dezelfde melding. Zie ik iets over het hoofd?

Het gaat over deze regel: Dim OutApp As Outlook.Application.

Met vriendelijke groet,

Code: 
Sub Knop160_Click()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2010
Dim strbody As String
Dim SigString As String
Dim Signature As String


' Late binding optie
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
'-----------------------------------------------------------

'-----------------------------------------------------------
'Early Binding optie, met Outlook bibliotheek geladen
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem
    'Set OutApp = New Outlook.Application
    'Set OutMail = OutApp.CreateItem(olMailItem)
'-----------------------------------------------------------

    strbody = "Hi there" & vbNewLine & vbNewLine & "This is line 1" & vbCrLf & "This is line 2" & vbCrLf _
              & "This is line 3" & vbNewLine & "This is line 4"

    'Change only Mysig.txt to the name of your signature
    SigString = Environ("AppData") & "\Microsoft\Handtekeningen\Test2.txt"
    
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next
    With OutMail
        .To = "emailadres@mail.nl
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody & vbNewLine & vbNewLine & Signature
        'You can add files also like this
        '.Attachments.Add ("C:\test.txt")
        .Display
        ''.Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Ik had de Outlook Object Library niet aangevinkt bij verwijzingen, waardoor ik die melding kreeg.
Nu dat ik dat heb ik aangevinkt, lijkt het te werken.

Mijn dank is groot OctaFish!:thumb:

Met vriendelijke groet,
 
Ik heb (helaas) nog een vraagje aan een van jullie. Op een andere website stond dezelfde vraag, maar daar kom ik er niet uit.

In mijn database wil ik via de button "Send e-mail" een mail sturen en dan wel zo dat het e-mail adres van diegene er al in staat bij "Aan".

Hier heb ik de volgende code voor gevonden:

Code: 
Private Sub cmdVerstuur_email_Click() 
On Error GoTo Err_cmdVerstuur_email_Click_Click 

If IsNull(cboEmailadres) Then 
Exit Sub 
End If 

Dim strMailadres As String 
Dim strOnderwerp As String 
Dim strTekst As Variant 

'Mail samenstellen 
strMailadres = Me.cboEmailadres 
strOnderwerp = Me.txtOnderwerp 
strTekst = Me.txtBerichttekst 

'Mail verzenden 
DoCmd.SendObject , , , strMailadres, , , strOnderwerp, strTekst, True 

Exit_cmdVerstuur_email_Click: 
Exit Sub 

Err_cmdVerstuur_email_Click: 
MsgBox Error 
Resume Exit_cmdVerstuur_email_Click 

End Sub

Nu is het zo dat ik hierbij weer een melding krijg, namelijk: Compile error: Variable not defined.
En dan wordt dit gemarkeerd: If IsNull(cboEmailadres) Then

Kan iemand mij vertellen wat ik hier verkeerd doe?

Mijn dank is wederom groot.

Mvg,
 
Dit is eigenlijk een andere vraag, dus daar zou je een aparte topic voor moeten maken. De fout is echter vrij simpel, dus vooruit dan maar :)

cboEmailadres verwijst naar een object op je formulier. Als dat er niet is, kan de code niet worden uitgevoerd en krijg je een foutmelding. Ofwel hernoem je emailveld naar cboEmailadres (de naam verwijst qua naamgeving overigens naar een keuzelijst) ofwel vervang de naam in de code.
 
Ik zal voortaan een nieuw topic aanmaken, als ik weer een nieuwe vraag heb. :)

Maar over die 'cboEmailadres', waar moet ik die dan precies aanpassen in de code?

Bvd,

EDIT: ik heb de code inmiddels zo aangepast, dat het nu lijkt te werken.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan