Trimitere automata email

Ce este nou in Microsoft Access 2013?
Informatii despre cum se utilizeaza Microsoft Access 2013.
Baze de date, Interogari, Formulare, Rapoarte, etc
Închis
dani7905
Mesaje: 41
Membru din: Mar Sep 10, 2013 10:04 am

Trimitere automata email

Mesaj de dani7905 » Joi Mar 05, 2015 12:26 pm

Buna ziua,

Am am aplicatia atasat cu un cod visual basic de trimitere automata email, la acea perioda m-a ajutat Dr.Excel.
Acum as vrea sa adaug la acel cod si un camp care sa imi permita sa atasez un fisier si sa fie trimis automat odata cu emailul.
Se poata adauga ?

Multumesc anticipat !
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

dani7905
Mesaje: 41
Membru din: Mar Sep 10, 2013 10:04 am

Re: Trimitere automata email

Mesaj de dani7905 » Mar Mar 17, 2015 1:36 pm

Buna,
Nu poate nimeni sa ma ajute :?

Multumesc!

cvmircea
Moderator
Moderator
Mesaje: 403
Membru din: Lun Aug 03, 2009 7:25 pm
Localitate: Alba Iulia
Contact:

Re: Trimitere automata email

Mesaj de cvmircea » Lun Mar 23, 2015 11:55 pm

Eu folosesc urmatorea varianta pe care am luat-o de pe net ( in comentarii poti gasi datele autorului )

Cod: Selectaţi tot

Option Compare Database
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'>>> Database by Tony Hine, alias Uncle Gizmo                                                  <<<
'>>> Created Mar, 2011                                                                         <<<
'>>> Last up-dated Mar, 2011                                                                   <<<
'>>> Telephone International: +44 1635 522233                                                  <<<
'>>> Telephone UK: 01635 533322                                                                <<<
'>>> e-mail: email@tonyhine.co.uk                                                              <<<
'>>> Skype: unclegizmo                                                                         <<<
'>>> I post at the following forum (mostly) :                                                  <<<
'>>> http://www.access-programmers.co.uk/forums/  (alias Uncle Gizmo)                          <<<
'>>> You can also find me on the Ecademy: http://www.ecademy.com/user/tonyhine                 <<<
'>>> If my e-mail don't work, try this website: http://www.tonyhine.co.uk/example_help.htm     <<<
'>>> I have now started a forum which contains video instructions here:                        <<<
'>>> http://msAccessHintsAndTips.Ning.Com/                                                     <<<
'>>> CODE SUPPLIED NOT CHECKED AND TESTED FOR ERRORS!!!! Be Warned                             <<<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Private Sub btnSendEmailTest_Click()
If IsNull(txtGmailFrom) Or txtGmailFrom = "" Or IsNull(txtGmailPassword) Or txtGmailPassword = "" Or IsNull(txtGmailTo) Or txtGmailTo = "" Then
    MsgBox "ALL Fields MUST be Filled"
    Exit Sub
End If

    MsgBox "True means the Message was sent >>> = " & fSendGmail, , "Send Gmail from MS Access by Tony Hine"
    
End Sub      'btnSendEmailTest_Click

Private Function fSendGmail() As Boolean 'Returns True if No Errors are Generated
On Error GoTo Err_ErrorHandler
fSendGmail = True

'THIS Example FROM:
'Windows® XP Under the Hood
'Pg. 266 Chapter 6 Messaging and Faxing Objects
'http://my.safaribooksonline.com/book/operating-systems/9780131390041/messaging-and-faxing-objects/265

'Extract
'This basic example sends a simple, no-frills text message every time the script is run:
'Example File script0603.vbs

'THIS IS A DIFFERENT Example FROM:
'Essential WAP™ for Web Professionals
'Pg. 96 Chapter 8. Example ASP Application > The SendMail() Function
'http://my.safaribooksonline.com/book/web-development/mobile/0130925683/example-asp-application/96

'Extract
'The SendMail() Function
'While longer, SendMail( ) is itself a simpler function than GetData( ) . It simply creates three
'objects: CDO. Message, CDO. Configuration, and a subobject of CDO. Configuration called
'Fields . The Scripting library used in GetData() is a default part of the ASP namespace, and
'therefore any new object created in the Scripting library is known. To use objects in the CDO
'library, the METADATA statements at the top of the ASP page are necessary.

'Standard CDO Constants
'NOTE --- If you set conCdoSmtpUseSSL to True, you may need to set conCdoSendUsingPort to 465 or port number specified by your ISP.
Const conStrPrefix As String = "http://schemas.microsoft.com/cdo/configuration/"
Const conCdoSendUsingPort As Integer = 2    'If incorrect raises this Error: -2147220960
'Const conSendPassword As String = "YourGmailPasswordHere"
Const conCdoBasic As Integer = 1
'Const conSendUserName As String = "YourGmailAddrHere@gmail.com"
Const conStrSmtpServer As String = "smtp.gmail.com"     'If incorrect raises this Error: -2147220973
Const conCdoSmtpUseSSL As Boolean = True    'Use Secure Sockets Layer (SSL) when posting via SMTP.
Const conCdoSmtpServerPort As Integer = 465 'Can be 465 or 587 'If incorrect raises this Error: -2147220973

Dim oMsg As Object
Dim oConf As Object

Dim strEmailAddr As String
strEmailAddr = txtGmailTo & ">"

'Create Objects
Set oMsg = CreateObject("CDO.Message")
Set oConf = CreateObject("CDO.Configuration")
Set oMsg.Configuration = oConf

'Build the Message
With oMsg
    .To = "<" & strEmailAddr       'If incorrect you will get an email From: Delivery Status Notification (Failure) Delivery to the following recipient failed permanently:
    .From = DeLa & "<MyGoogleMailAddr@gmail.com>"    'If incorrect raises this Error: -2147220973
    .subject = Subiect
    .textBody = Mesaj
    If Not IsNull(Me.Atasament) Then
    .AddAttachment Atasament
    End If
    
End With
            
''Set Delivery Options
            With oConf.Fields
                .Item(conStrPrefix & "sendusing") = conCdoSendUsingPort
                .Item(conStrPrefix & "smtpserver") = conStrSmtpServer
                .Item(conStrPrefix & "smtpauthenticate") = conCdoBasic
                .Item(conStrPrefix & "sendusername") = txtGmailFrom
                .Item(conStrPrefix & "sendpassword") = txtGmailPassword
                '.Item(conStrPrefix & "sendusername") = conSendUserName 'IF you want to hard code the username you can reactivate this line.
                '.Item(conStrPrefix & "sendpassword") = conSendPassword 'IF you want to hard code the password you can reactivate this line.
                .Item(conStrPrefix & "smtpusessl") = conCdoSmtpUseSSL
                .Item(conStrPrefix & "smtpserverport") = conCdoSmtpServerPort
                .Update 'Commit Changes
            End With

'Deliver the Message
oMsg.send

Exit_ErrorHandler:
'Access 2007 Developer Reference > Microsoft Data Access Objects (DAO) Reference > DAO Reference > Recordset Object > Methods
'An alternative to the Close method is to set the value of an object variable to Nothing (Set dbsTemp = Nothing).
    Set oMsg.Configuration = Nothing
    Set oConf = Nothing
    Set oMsg = Nothing
    Exit Function

Err_ErrorHandler:
    If err.Number <> 0 Then fSendGmail = False
        Select Case err.Number

            Case -2147220977  'Likely cause, Incorrectly Formatted Email Address, server rejected the Email Format
                MsgBox "Error From --- fSendGmail --- Incorrectly Formatted Email ---  Error Number >>>  " _
                & err.Number & "  Error Desc >>  " & err.Description, , "Format the Email Address Correctly"

            Case -2147220980  'Likely cause, No Recipient Provided (No Email Address)
                MsgBox "Error From --- fSendGmail --- No Email Address ---  Error Number >>>  " _
                & err.Number & "  Error Desc >>  " & err.Description, , "You Need to Provide an Email Address"

            Case -2147220960 'Likely cause, SendUsing Configuration Error
                MsgBox "Error From --- fSendGmail --- The SendUsing configuration value is invalid --- LOOK HERE >>> sendusing) = conCdoSendUsingPort ---  Error Number >>>  " _
                & err.Number & "  Error Desc >>  " & err.Description, , "SendUsing Configuration Error"
            
            Case -2147220973  'Likely cause, No Internet Connection
                MsgBox "Error From --- fSendGmail --- No Internet Connection ---  Error Number >>>  " _
                & err.Number & "  Error Desc >>  " & err.Description, , "No Internet Connection"
            
            Case -2147220975  'Likely cause, Incorrect Password
                MsgBox "Error From --- fSendGmail --- Incorrect Password ---  Error Number >>>  " _
                & err.Number & "  Error Desc >>  " & err.Description, , "Incorrect Password"
            
            Case Else   'Report Other Errors
                MsgBox "Error From --- fSendGmail --- Error Number >>>  " & err.Number _
                & "  <<< Error Description >>  " & err.Description
        End Select
        
    Resume Exit_ErrorHandler
End Function      'fSendGmail

Închis

Înapoi la “Intrebari despre Access 2013”