Verzenden email via excel (vba) zonder outlook (met windows mail)

Status
Niet open voor verdere reacties.
O

Offthefield

Gebruiker
Lid geworden
27 apr 2005
Berichten
369
Ik ben op zoek naar een vba-programma voor het verzenden uit
excel zonder outlook (via window mail)

Ik heb gezocht bij Ron de Bruin maar hier kan ik niets vinden
of ik kijk er over heen

Heeft iemand misschien een link naar een leuk voorbeeldje

bvd

Offthefield
 
@ Offthefield
Kan je gelijk je vraag van 6 oktober eens bekijken of deze naar wens is beantwoord ?
Indien Ja, markeer je hem dan gelijk als Opgelost.
 
Ik heb de mogelijkheden van Ron de Bruin geprobeerd maar de gegevens blijven
in POST (uit) staan in de Windows Mail en worden dus niet verzonden

Kan iemand mij vertellen wat ik fout doe

mvrgr

Offthefield
 
Ik heb een programma gevonden die van uit Excel via Outlook verzend,
wat moet ik wijzigen om het via Windows Mail te versturen
en wat moet ik wijzigen om meerdere emails te versturen

Code: 
Option Explicit


Public Sub CommandButton1_Click()

' sendmail Macro
'
'
Dim objOutlook
Dim objNameSpace

Dim mItem

Dim strReceipient
Dim strSubject
Dim strBodyText
Dim strMsg

Dim pAttachments
Dim strAttach


Const olMailItem = 0

''strMsg = "Enter Receipient Mail Address." & vbCrLf & "(Format: [email]santiago1094@zonnet.nl[/email])"
strMsg = "pieter@zonnet.nl" & vbCrLf & "(Format: [email]pieter@zonnet.nl[/email])"
strReceipient = Range("A1")

''mItem = "santiago1094@zonnet.nl"

strSubject = "Message from VBS script"

strBodyText = "Wow! This really works!"

strAttach = "c:\Mijn Documenten\info1.xls"

Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set mItem = objOutlook.CreateItem(olMailItem)


mItem.To = strReceipient
mItem.Subject = strSubject
mItem.Body = strBodyText

If Len(strAttach) > 0 Then
Set pAttachments = mItem.Attachments
pAttachments.Add strAttach
End If

mItem.Save
mItem.Send




' **** Clean up
'
Set mItem = Nothing
Set objNameSpace = Nothing
Set objOutlook = Nothing


If strReceipient = "" Then
MsgBox "No Receipient provided. Mail not sent", vbInformation, "Mail Error"
End If

End Sub

Bij voorbaat dank

Offthefield
 
Laatst bewerkt door een moderator:
Om via Windows Live Mail te verzenden moet de geadresseerde wel in je contactenlijst staan. Is dit het geval wel ?
 
Ik ben alweer een paar uur aan het proberen met de onderstaande procedure,
maar ik krijg de volgende melding :

fout -2147220977 (8004020f), wat is kan ik doen om de melding te veranderen

bvd

Offthefield

Code: 
Sub CDO_Mail_Small_Text()
    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/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.tele2.nl"
            ''.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.versatel.nl"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
            '' Uitgaande poort voor
            ''.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
            .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 = "peter@zonnet.nl"
        .CC = ""
        .BCC = ""
        .From = """Ron"" <ron@zonnet.nl>"
        .Subject = "New figures"
        .TextBody = strbody
        .Send
    End With

End Sub
 
Laatst bewerkt door een moderator:
mogelijkheid 1 (aanmelden verplicht)
na
Code: 
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
invoegen
Code: 
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "offthefields_gebruikersnaam"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "offthefields_wachtwoord"

mogelijkheid 2 (beveiligd aanmelden TRUE of FALSE)
na
Code: 
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
invoegen
Code: 
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = TRUE of FALSE
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

mogelijkheid 3 (andere instelling)
Code: 
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
veranderen in
Code: 
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 1

zoals je ziet zijn er verschillende combinaties mogelijk, je moet meerdere combinaties doorlopen voordat je de juist hebt

download CDOSYS3 van http://www.worksheet.nl/forumexcel/...ailen-met-vista-mail-outlook-express-etc.html om te verschillende combinaties gecombineerd te zien
 
Ik heb een voorbeeld gevonden die ik nu werkend heb, maar ik ga ook even kijken of
de hierboven gegeven antwoorden in een andere versie kan gebruiken.

Hartelijk dank voor de reaktie

Offthefield

Code: 
Private Sub CommandButton2_Click() 'http://www.paulsadowski.com/WSH/cdo.htm
    Dim objFile As Object
    Dim objFilSysObj As Object
    Dim objTexStr As Object
    Dim objMessage As Object
    Dim strFile As String
    Dim strHTMLBody As String
    
''Bereik            E1:G5               Tekst in Cel(E1:G5)
''SMTP-server       smtp.gmail.com      (Cel C3)
''Gebruikersnaam    invoeren1           (Cel C4)
''Wachtwoord        invoeren            (Cel C5)
''Onderwerp         test1               (Cel C6)
''Van naam          Cees                (Cel C7)
''Van E-mailadres   [email]invoeren1@gmail.com[/email] (Cel C8)
''Aan E-mailadres   [email]jan@hetnet.nl[/email]       (Cel C9)

        Set objMessage = CreateObject("CDO.Message")
        With objMessage
            .Subject = Range("Onderwerp").Value
            .From = String(2, 34) & Range("Van_naam").Value & String(2, 34) & " <" & Range("Van_E_mailadres").Value & ">"
            .To = Range("Aan_E_mailadres").Value
            
            Range(Range("Bereik")).Copy
            Set objFile = Workbooks.Add(1)
            With objFile.Sheets(1)
                .Cells(1).PasteSpecial 8 'kolom breedte, pakt geen xl-waarde door fout in excel
                .Cells(1).PasteSpecial xlPasteValues
                .Cells(1).PasteSpecial xlPasteFormats
                .Cells(1).Select
                Application.CutCopyMode = False 'verwijder cursor
            End With
            
            strFile = ThisWorkbook.Path & "/Tijdelijk.htm"
            With objFile.PublishObjects.Add(xlSourceRange, strFile, objFile.Sheets(1).Name, objFile.Sheets(1).UsedRange.Address, xlHtmlStatic)
                .Publish (True)
            End With
         
            Set objFilSysObj = CreateObject("Scripting.FileSystemObject")
            Set objTexStr = objFilSysObj.GetFile(strFile).OpenAsTexTStream(1, -2)
            strHTMLBody = objTexStr.ReadAll
            objTexStr.Close
            Kill strFile
            objFile.Close (False)
            Set objTexStr = Nothing
            Set objFilSysObj = Nothing
            
            strHTMLBody = Replace(strHTMLBody, "align=center x:publishsource=", "align=left x:publishsource=") 'links uitlijnen
         
            .HTMLBody = strHTMLBody
            With .configuration.Fields
                .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/smtpserverport") = 465
                    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
                    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Range("Gebruikersnaam").Value
                    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Range("Wachtwoord").Value
                    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True 'DEZE REGEL IS NODIG
                .Update
            End With
            .Send
        End With
End Sub
 
Laatst bewerkt door een moderator:
je weet nu welke combinatie werkt
nu kan je een regel per keer weglaten en kijken als het blijft werken en zodoende de code optimaliseren

kan je een samenvatting geven van je instellingen (gebruikersnaam en wachtwoord mag je onherkenbaar maken), ik ben benieuwd als tele2/versatel andere settings hebben dan b.v. hotmail
 
Antwoord voor Alphamax

Bij mij werkt de versie van Versatel :

Code: 
''Bereik            E1:G5               Tekst in Cel(E1:G5)
[COLOR="red"]''SMTP-server       smtp.versatel.nl      (Cel C3)[/COLOR][COLOR="red"]''Gebruikersnaam    invoeren1           (Cel C4)
''Wachtwoord        invoeren            (Cel C5)[/COLOR]''Onderwerp         test1               (Cel C6)
''Van naam          Cees                (Cel C7)
[COLOR="red"]''Van E-mailadres   [email]invoeren1@versatel.nl[/email] (Cel C8)[/COLOR]''Aan E-mailadres   [email]jan@hetnet.nl[/email]       (Cel C9)

De gebruikersnaam en het 1e deel vh emailadres dienen hetzelfde te zijn

.HTMLBody = strHTMLBody
            With .configuration.Fields
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.versatel.nl"
                    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587                    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
                    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Range("Gebruikersnaam").Value
                    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Range("Wachtwoord").Value
                    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True 'DEZE REGEL IS NODIG
                .Update
            End With

Hier boven zijn de genoemde wijzigingen, ik hoop dat je eruit komt

IK wil iedereen nog even bedanken voor de snelle reaktie, die voor mij tot het oplossingen van dit vraagstuk hebben geleid

Offthefield
 
Laatst bewerkt door een moderator:
@Offthefield: Nog eenmaal, lees mijn reactie hierboven.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan