• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Mailen uit excel CDO met Gmail

Status
Niet open voor verdere reacties.
J

Jacob01

Gebruiker
Lid geworden
7 feb 2009
Berichten
65
Ik heb deze site doorzocht en die van Ron de Bruin, maar ik kom er nog niet uit.

Graag wil ik de active.sheet mailen, en het adres halen uit een cel uit de active.sheet.

Ik gebruik geen Outlook en ook geen windows mail. Dus het moet puur met CDO met gmail.

Bij voorbaat dank!

Deze code heb ik tot nu toe, hoe moet deze worden als ik de active.sheet, in een email krijg?

Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = ".......@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "geheim natuurlijk"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With

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

With iMsg
Set .Configuration = iConf
.To = "............@hotmail.com"
.CC = ""
.BCC = ""

.From = """Jaap Tijssen"" <............@gmail.com>"
.Subject = "Important message"
.TextBody = strbody
.Send
End With

End Sub
Klik om te vergroten...
 
Laatst bewerkt:
Beste Jacob01 ik kan je enkel doorverwijzen naar deze site ( topic) daat staat een uitgewerkt voorbeeld .
suc6
 
Beste Jacob01, je hebt de site van Ron de Bruin gevonden. Daar is ook een voorbeeldworkbook waarin de verschillende mogelijkheden met hun bijhorende code besproken worden
 
Warme bakkertje zei:
Beste Jacob01, je hebt de site van Ron de Bruin gevonden. Daar is ook een voorbeeldworkbook waarin de verschillende mogelijkheden met hun bijhorende code besproken worden
Klik om te vergroten...

Ik heb dat voorbeeld gedownload maar daar staat bij GMAIL alleen de code die ik hier boven heb staan!

Is het met GMAIL CDO uberhaupt mogelijk om de inhoud van een sheet te mailen en het emailadres uit een cel te halen?
 
Heb jij toevallig een KPN, Planet, oid internet verbinding? Dan staat namelijk poort 25 geblokkeerd en kun je alleen naar de mailservers van KPN mailen. Dit kun je even testen door een command window te openen (start, uitvoeren, cmd) en daar dan het volgende te typen:
Code: 
telnet smtp.gmail.com 25
Je zou nu antwoord van mx.google moeten krijgen:
Code: 
220 mx.google.com ESMTP 24sm14769978eyx.30
Je kunt hier nu gewoon quit intypen en dan op enter drukken, de verbinding wordt dan verbroken. Maar mogelijk krijg jij een melding dat er geen verbinding kan worden gemaakt en dan werkt je CDO projectje natuurlijk ook niet.
 
ReneDirks zei:
Heb jij toevallig een KPN, Planet, oid internet verbinding? Dan staat namelijk poort 25 geblokkeerd en kun je alleen naar de mailservers van KPN mailen. Dit kun je even testen door een command window te openen (start, uitvoeren, cmd) en daar dan het volgende te typen:
Code: 
telnet smtp.gmail.com 25
Je zou nu antwoord van mx.google moeten krijgen:
Code: 
220 mx.google.com ESMTP 24sm14769978eyx.30
Je kunt hier nu gewoon quit intypen en dan op enter drukken, de verbinding wordt dan verbroken. Maar mogelijk krijg jij een melding dat er geen verbinding kan worden gemaakt en dan werkt je CDO projectje natuurlijk ook niet.
Klik om te vergroten...

Dank voor het antwoord, maar hij mailt wel, alleen krijg ik het niet voorelkaar, en staat er geen voorbeeld bij RondeBruin van hoe ik bij GMAIL, het email adres uit een cel haal en ik de op dat moment active sheet kan mailen.


De code van mij hierboven moet ik het email adres telkens in de macro intypen bij:

With iMsg
Set .Configuration = iConf
.To = "............@hotmail.com"
.CC = ""
.BCC = ""
Klik om te vergroten...

En mijn bericht is geen sheet van excel maar moet ik intypen namelijk hier:

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
Klik om te vergroten...
 
Ah, dat wist ik niet. Dan zou je zoiets moeten doen (alleen even de aanvullingen):

Code: 
Dim ws As Worksheet
Dim r As Range
Set ws = Application.ActiveSheet
Set r = ws.Cells(1, 1)   '<- hier staat het e-mail adres in A1
.To = r.Value
Vervolgens zul je met .AddAttachment (filepath) een attachment aan je mail moeten hangen (je zegt activesheet, maar bedoel je niet het hele werkboek?). En daar komt dan net het probleem, want je kunt dat bestand niet attachen terwijl het open is. Je zult dus met een (worksheet) ws.SaveAs het bestand naar een andere locatie moeten opslaan en dan pas moeten gaan mailen. Overigens kun je de naam van het werkboek vinden met ThisWorkbook.FullName of ThisWorkbook.FullNameURLEncoded

Succes!
 
Code: 
Option Explicit

'This procedure will mail every Worksheet with an address in cell A1 in the body of the mail.
'This way you can send each sheet to another person.
'It does this by cycling through each worksheet in the workbook and checking cell A1 for the @ character.
'If found, a copy of the worksheet is made, and then sent by e-mail to the address in cell A1.
'And finally, the file is deleted from your hard disk
'
'This macro use the RangetoHTML Function in the bodyfunction module.
Sub CDO_Mail_Every_Worksheet_Body()
    Dim iMsg As Object
    Dim iConf As Object
    Dim ws As Worksheet
    Dim Sourcewb As Workbook
    '    Dim Flds As Variant
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
  
    Set iConf = CreateObject("CDO.Configuration")

    '    iConf.Load -1    ' CDO Source Defaults
    '    Set Flds = iConf.Fields
    '    With Flds
    '        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    '        .Update
    '    End With
    Set Sourcewb = ThisWorkbook
    For Each ws In Sourcewb.Worksheets
        If ws.Range("a1").Value Like "?*@?*.?*" Then
            Set iMsg = CreateObject("CDO.Message")
            With iMsg
                Set .Configuration = iConf
                .To = ws.Range("a1").Value
                .From = """Ron"" <ron@something.nl>"
                .Subject = "Body of sheet : " & ws.Name
                .HTMLBody = RangetoHTML(ws.UsedRange)
                .Send
            End With
            Set iMsg = Nothing
        End If
    Next ws
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
Heb je bovenstaande al eens getest ? e-mailadres in A1
 
ReneDirks zei:
Ah, dat wist ik niet. Dan zou je zoiets moeten doen (alleen even de aanvullingen):

Code: 
Dim ws As Worksheet
Dim r As Range
Set ws = Application.ActiveSheet
Set r = ws.Cells(1, 1)   '<- hier staat het e-mail adres in A1
.To = r.Value
Vervolgens zul je met .AddAttachment (filepath) een attachment aan je mail moeten hangen (je zegt activesheet, maar bedoel je niet het hele werkboek?). En daar komt dan net het probleem, want je kunt dat bestand niet attachen terwijl het open is. Je zult dus met een (worksheet) ws.SaveAs het bestand naar een andere locatie moeten opslaan en dan pas moeten gaan mailen. Overigens kun je de naam van het werkboek vinden met ThisWorkbook.FullName of ThisWorkbook.FullNameURLEncoded

Succes!
Klik om te vergroten...


Sorry dit gaat mij boven de pet haha.
Ik zit op het niveau: " een aap een kunstje leren."

Het is met gmail zeker niet mogelijk de sheet zelf in de mail te zetten en niet als bijlage maar de gegevens uit de sheet in de mail?
 
Yep, de code van Rudi doet dat. En wel precies in deze regel:
.HTMLBody = RangetoHTML(ws.UsedRange)
 
Warme bakkertje zei:
Code: 
Option Explicit

'This procedure will mail every Worksheet with an address in cell A1 in the body of the mail.
'This way you can send each sheet to another person.
'It does this by cycling through each worksheet in the workbook and checking cell A1 for the @ character.
'If found, a copy of the worksheet is made, and then sent by e-mail to the address in cell A1.
'And finally, the file is deleted from your hard disk
'
'This macro use the RangetoHTML Function in the bodyfunction module.
Sub CDO_Mail_Every_Worksheet_Body()
    Dim iMsg As Object
    Dim iConf As Object
    Dim ws As Worksheet
    Dim Sourcewb As Workbook
    '    Dim Flds As Variant
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
  
    Set iConf = CreateObject("CDO.Configuration")

    '    iConf.Load -1    ' CDO Source Defaults
    '    Set Flds = iConf.Fields
    '    With Flds
    '        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    '        .Update
    '    End With
    Set Sourcewb = ThisWorkbook
    For Each ws In Sourcewb.Worksheets
        If ws.Range("a1").Value Like "?*@?*.?*" Then
            Set iMsg = CreateObject("CDO.Message")
            With iMsg
                Set .Configuration = iConf
                .To = ws.Range("a1").Value
                .From = """Ron"" <ron@something.nl>"
                .Subject = "Body of sheet : " & ws.Name
                .HTMLBody = RangetoHTML(ws.UsedRange)
                .Send
            End With
            Set iMsg = Nothing
        End If
    Next ws
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
Heb je bovenstaande al eens getest ? e-mailadres in A1
Klik om te vergroten...

Hij geeft gelijk al een foutmelding, en deze is niet voor GMAIL.

Ik gebruik alleen GMAIL.
 
Code: 
Sub CDO_Mail_Small_Text_2()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "jaaptijssen280@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "......."
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    strbody = "Goedenmiddag" & vbNewLine & vbNewLine & _
              " Hartelijk dank voor het inschrijven " & vbNewLine & _
              "Mailen uit Excel" & vbNewLine & _
              " " & vbNewLine & _
              "This is line 4"

    With iMsg
        Set .Configuration = iConf
        .To = ws.Range("a1").Value
        .CC = ""
        .BCC = ""
        
        .From = "Fietstocht voor Malawi"
        .Subject = "Bevestiging inschrijving & Factuur"
        .TextBody = strbody
        .Send
    End With

End Sub


Ik weet niet wat en waar ik het in wil moet vullen.

Wie kan mij helpen? Dat deze CODE aangepast wordt zodanig dat ik met gmail account

Het aan emailadres uit een cel haal.
De inhoud van de sheet in de mail komt.

S.V.P. indien mogelijk deze macrocode aanpassen en niet stukjes quoten omdat ik niet weet waar ik ze moet plaatsen, en omdat er vaak stukjes worden gepost die alleen werken bij Outlook of in ieder geval niet GMAIL accounts.


In ieder geval wel bedankt voor de moeite van de voorgaande reacties hoor! maar die zijn te moeilijk of sluiten niet aan op mijn vraag!
 
Wil je de hele sheet sturen? Dus inclusief het e-mail adres in A1? Of een gedeelte van de sheet?
 
ReneDirks zei:
Wil je de hele sheet sturen? Dus inclusief het e-mail adres in A1? Of een gedeelte van de sheet?
Klik om te vergroten...

Hele sheet dus inclusief cel a1.
Als het kan de hele code posten, en ik gebruik alleen gmail :confused:

Echt top dat je zo ene hardleerse excel prutser als ik blijft helpen haha.
 
Je kunt geen HTMLBody en (Text)Body tegelijk doen, dus die heb ik even verwijderd. Dit zou moeten werken, ervan uitgaande dat de functie van Ron de Bruin werkt.

Code: 
Sub CDO_Mail_Small_Text_2()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "jaaptijssen280@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "......."
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    With iMsg
        Set .Configuration = iConf
        .To = ws.Range("a1").Value
        .CC = ""
        .BCC = ""
        
        .From = "jaaptijssen280@gmail.com"
        .Subject = "Bevestiging inschrijving & Factuur"
        .HTMLBody = RangetoHTML(ws.UsedRange)
        .Send
    End With

End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
Dit is wat ik zocht.
Echt super bedankt voor alle moeite en tijd! :thumb:
 
With iMsg
Set .Configuration = iConf
.To = ws.Range("a1").Value
.CC = ""
.BCC = ""

.From = """Fietstocht 8 mei Z.H.H.K."" <jaaptijssen280@gmail.com>"
.Subject = "Bevestiging inschrijving & Factuur fietstocht"
.HTMLBody = RangetoHTML(ws.UsedRange)
.Send
End With
Klik om te vergroten...

Is het ook mogelijk dat ik meerdere adressen haal uit bijvoorbeeld sheet 2 row ("i10:i20") waar de mail naar gestuurd wordt?


Ik vond wat bij Ron de Bruin maar ik kwam daar niet uit:

Changing the To line

If you want to mail to all E-mail addresses in a range then use this code
instead of .To = "ron@debruin.nl"

The example below will use the cells from sheets("Sheet1") in ThisWorkbook (workbook with the code)
It is possible that you must use ActiveWorkbook or something else in your code to use it.
Dim cell As Range
Dim strto As String
On Error Resume Next
For Each cell In ThisWorkbook.Sheets("Sheet1") _
.Range("A1:A10").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next cell
On Error GoTo 0
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
Change the To line to .To = strto
Klik om te vergroten...

Waar moet ik deze precies plaatsen dan?
 
Yep
Code: 
'----------snap----------
Set .Configuration = iConf
.CC = ""
.BCC = ""

dim i as integer
dim strAddresses as string
dim r as range
for i = 0 to 9 
   set r = ws.cells(i,9)
   strAddresses = strAddresses & ";" & r.value
next
.To = mid(strAddresses,2)
.From = """Fietstocht 8 mei Z.H.H.K."" <jaaptijssen280@gmail.com>"
.Subject = "Bevestiging inschrijving & Factuur fietstocht"
.HTMLBody = RangetoHTML(ws.UsedRange)
'----------snap----------
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan