Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Automating Outlook EXPRESS 5 from VB6

Posted on 1999-07-14
2
Medium Priority
?
489 Views
Last Modified: 2011-10-03
I'm tring to write an app( more of a formless service) that checks for a certain time then dials an ISP and sends out an email with an attachment that changes daily.  I want to do it with Outlook Express 5 not Outlook 97 or 98 or whatever other version. I'm working on a Win95 platform with VB6 SP3.
Thanks for your help folks.
0
Comment
Question by:jagu98
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
2 Comments
 
LVL 6

Accepted Solution

by:
setiawan earned 1200 total points
ID: 1524822
Try this
Private Sub Command1_Click()
    ' this command button is used to start a MAPI session, log on the
    '     the
    ' mail service, attach the created check summary text file to a n
    '     ew
    ' message, send the message and then close the session
    ' declare local variables here
    Dim strUserId As String
    Dim strPassword As String
    Dim strFileName As String
    Dim strFilePath As String
    ' set the mouse pointer to indicate the app is busy
    Screen.MousePointer = vbHourglass
    ' set the values for the file name and the file path
    strFileName = "sendmail.frm" ' this is where you would put any file attachments
    strFilePath = App.Path & "\"
    ' set the user name and password properties on the session contro
    '     l
    mapiLogOn.UserName = "user" ' network user name and password !
    mapiLogOn.Password = "testing"
    ' start a new email session
    mapiLogOn.SignOn


    Do While mapiLogOn.SessionID = 0


        DoEvents ' need to wait until the new session is created
        Loop

        'create a new message and address it
        MAPIMessages1.SessionID = mapiLogOn.SessionID
        MAPIMessages1.Compose
        MAPIMessages1.RecipDisplayName = "Danny Setiawan"
        MAPIMessages1.AddressResolveUI = True
        MAPIMessages1.ResolveName
        MAPIMessages1.RecipAddress = "smtp:ashiang@hotmail.com"
        ' note that I prefixed the address with "smtp". This is required
        '     by exchange
        ' server, or it does not know what service to use for outgoing ma
        '     il.
        MAPIMessages1.MsgSubject = "Test of the Email function"
        MAPIMessages1.MsgNoteText = " This is a test of the email function, If you" _
        & "receive this Then the program has worked successfully." & vbCrLf
        ' attaching the file
        MAPIMessages1.AttachmentPosition = Len(MAPIMessages1.MsgNoteText) - 1
        ' the line above places the attachment at the end of the text.
        MAPIMessages1.AttachmentPathName = strFilePath & strFileName
        ' now send the message
        MAPIMessages1.Send False
        mapiLogOn.SignOff
        MsgBox "File sent to specified receiptent."
        ' now set the mouse pointer back to normal
        Screen.MousePointer = vbNormal
End Sub
0
 
LVL 6

Expert Comment

by:setiawan
ID: 1524823
credits for ameba (answered by ameba)
paste into vb
VERSION 5.00
Begin VB.Form frmSendMail
   Caption         =   "Send E-mail using Outlook Express"
   ClientHeight    =   3690
   ClientLeft      =   270
   ClientTop       =   1020
   ClientWidth     =   5490
   LinkTopic       =   "Form1"
   ScaleHeight     =   3690
   ScaleWidth      =   5490
   Begin VB.CheckBox chkSendEnter
      Caption         =   "S&end to Outbox (i.e. send Ctrl-Enter)"
      Height          =   495
      Left            =   2520
      TabIndex        =   9
      Top             =   2520
      Width           =   2055
   End
   Begin VB.CommandButton cmSend
      Caption         =   "Send &Now"
      Height          =   375
      Left            =   2760
      TabIndex        =   10
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CommandButton cmCancel
      Cancel          =   -1  'True
      Caption         =   "Close"
      Height          =   375
      Left            =   4080
      TabIndex        =   11
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CheckBox chkOffer
      Caption         =   "&Offer"
      Height          =   315
      Left            =   180
      TabIndex        =   8
      Top             =   3060
      Value           =   1  'Checked
      Width           =   1455
   End
   Begin VB.CheckBox chkInvoice
      Caption         =   "&Invoice"
      Height          =   315
      Left            =   180
      TabIndex        =   7
      Top             =   2760
      Value           =   1  'Checked
      Width           =   1455
   End
   Begin VB.TextBox txtMsg
      Height          =   1065
      Left            =   60
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   5
      Top             =   1320
      Width           =   5355
   End
   Begin VB.TextBox txtSubject
      Height          =   285
      Left            =   1140
      TabIndex        =   4
      Text            =   "Invoice no 101"
      Top             =   900
      Width           =   3975
   End
   Begin VB.TextBox txtRecip
      Height          =   285
      Left            =   1140
      TabIndex        =   2
      Text            =   "<xxyy@usa.net>, <ameba @zg.tel.hr>"
      Top             =   540
      Width           =   3975
   End
   Begin VB.CheckBox chkBcc
      Caption         =   "&Bcc - Recipients cannot see who receives a msg"
      Height          =   375
      Left            =   900
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   60
      Width           =   4215
   End
   Begin VB.Label Label4
      Caption         =   "Attachments:"
      Height          =   195
      Left            =   180
      TabIndex        =   6
      Top             =   2520
      Width           =   1455
   End
   Begin VB.Label Label2
      Alignment       =   1  'Right Justify
      Caption         =   "S&ubject:"
      Height          =   195
      Left            =   180
      TabIndex        =   3
      Top             =   960
      Width           =   915
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "&To:"
      Height          =   195
      Left            =   180
      TabIndex        =   1
      Top             =   600
      Width           =   915
   End
End
Attribute VB_Name = "frmSendMail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Send email using Outlook Express (IE4 required)
' Created by: Bruno Paris, ameba @zg.tel.hr
Option Explicit
' API declarations
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1
'
Private Const bnd = "_NextPart_001_"     ' boundary
Private Const charset = "iso-8859-2"     ' or windows-1250

Private Sub cmCancel_Click()
    Unload Me
End Sub

Private Sub cmSend_Click()
'    Send email
    Dim i As Integer
    Dim iRet As Long, numfile%, FileName$
    Dim recips As String  ' recipients
    On Error GoTo SendErr ' enable error handling
'------------------------------------------------
'    Create string for field "To:"
    recips = txtRecip.Text
'    or:
'    RecipArray() holds email addresses, List1 holds names
'    For i = 0 To List1.ListCount - 1
'        If List1.Selected(i) = True Then
'            If Len(recips) > 0 Then recips = recips & ", " 
'            recips = recips & "<" & RecipArray(List1.ItemData(i)) & ">"
'        End If
'    Next
'------------------------------------------------
    numfile% = FreeFile
    ' Open temporary file
    FileName$ = getapppath() & "~temp.eml"
    Open FileName$ For Output As #numfile%
    ' display hourglass
    Screen.MousePointer = vbHourglass
    DoEvents
    ' start writing to temporary file
'------------------------------------------------
' "Blind carbon copy" or "To"
    If chkBcc.Value = 1 Then
        Print #numfile%, "Bcc: " & recips
    Else
        Print #numfile%, "To: " & recips
    End If
'------------------------------------------------
' subject
    Print #numfile%, "Subject: " & txtSubject.Text
'------------------------------------------------
    Print #numfile%, "MIME-Version: 1.0" & vbCrLf & "Content-Type: multipart/mixed;"
    Print #numfile%, vbTab & "boundary=""" & bnd & """"
    Print #numfile%, "X-Unsent: 1"
    Print #numfile%,
    Print #numfile%,
    Print #numfile%, "--" & bnd
    Print #numfile%, "Content-Type: text/plain;"
    Print #numfile%, vbTab & "charset=""" & charset & """"
    Print #numfile%, "Content-Transfer-Encoding: 7bit"
    Print #numfile%,
'------------------------------------------------
' msg body
    Print #numfile%, txtMsg.Text
'------------------------------------------------
    ' simple text file, max 60 characters per line
    If chkInvoice > 0 Then ' attach file1
        Dim att As String
        att = "invoice.txt"
        Print #numfile%, "--" & bnd
        Print #numfile%, "Content-Type: text/plain;"
        Print #numfile%, vbTab & "name=""" & att & """"
        Print #numfile%, "Content-Transfer-Encoding: 7bit"
        Print #numfile%, "Content-Disposition: attachment;"
        Print #numfile%, vbTab & "filename=""" & att & """"
        Print #numfile%,
        ' write invoice data to file
        Print #numfile%, "Invoice"
        Print #numfile%,
        Print #numfile%,
        Print #numfile%, "No: " & vbTab & "101/99"
        Print #numfile%, "Date:" & vbTab & Format$(Now, "Short Date")
        Print #numfile%,
        Print #numfile%, "QUANTITY    DESCRIPTION UNIT PRICE  AMOUNT"
        Print #numfile%, "5           PC                $890  $4450"
        Print #numfile%,
        Print #numfile%, "SUBTOTAL:"
        Print #numfile%, "SALES TAX:"
        Print #numfile%, "TOTAL DUE:"
        Print #numfile%,
        Print #numfile%,
        Print #numfile%, "SALESPERSON:"
        Print #numfile%,
        Print #numfile%, "Make all checks payable to: Your Company Name"
        Print #numfile%, "If you have any questions concerning this invoice, call: Contact Name, Phone Number"
        Print #numfile%,
        Print #numfile%,
        Print #numfile%, "THANK YOU FOR YOUR BUSINESS!"
        Print #numfile%,
    End If
    ' simple text file, max 60 characters per line
    If chkOffer.Value Then ' attach file2
        att = "offer.txt"
        Print #numfile%, "--" & bnd
        Print #numfile%, "Content-Type: text/plain;"
        Print #numfile%, vbTab & "name=""" & att & """"
        Print #numfile%, "Content-Transfer-Encoding: 7bit"
        Print #numfile%, "Content-Disposition: attachment;"
        Print #numfile%, vbTab & "filename=""" & att & """"
        Print #numfile%,
        ' write offer data to file
        Print #numfile%, "Offer"
        Print #numfile%,
        Print #numfile%, "Created: " & Format$(Now, "Short Date")
        Print #numfile%, "etc."
        Print #numfile%,
        Print #numfile%, "Thank you for considering our offer!"
        Print #numfile%,
    End If
'------------------------------------------------
    Print #numfile%, "--" & bnd & "--"
' close temporary file
    Close #numfile%
    Reset ' flush all file buffers
     
    ' wait 1-2 seconds
    For i = 1 To 10
        Sleep (100)
        DoEvents
    Next

'------------------------------------------------
    ' now, open created file with default e-mail program
    iRet = ShellExecute(Me.hwnd, "Open", _
       FileName$, _
       "", "c:\", SW_SHOWNORMAL)
    ' if default e-mail program is Outlook Express,
    ' this will show "New Message" window
'------------------------------------------------
       
    DoEvents
    Sleep (200)
    On Error Resume Next
    Dim numrtr As Integer
rtr:
    numrtr = numrtr + 1
    DoEvents
    Sleep (100)
    ' set focus to "Outlook Express" window with new msg
    AppActivate txtSubject.Text
    If Err <> 0 Then
        Err = 0
        ' if set focus was not succesfull, wait a while and retry
        If numrtr < 100 Then GoTo rtr
    Else
        ' now, press Ctrl-Enter to send to outbox
        If chkSendEnter.Value Then SendKeys "^~"
    End If
     
    ' After mail is in Outbox, we might want to connect if needed:
'    If IsConnected() = False Then
'        StartConnection
'    End If
    Screen.MousePointer = vbNormal
    Exit Sub
SendErr:
    Screen.MousePointer = vbNormal
    MsgBox Err.Description
    Exit Sub
End Sub

Function getapppath() As String
' returns path
    Dim sTemp As String
    sTemp = App.Path
    If Right$(sTemp, 1) <> "\" Then sTemp = sTemp & "\"
    getapppath = sTemp
End Function

Private Sub Form_Load()
    txtMsg.Text = "My dear customer," & vbCrLf & _
        "This is the offer you cannot refuse." & vbCrLf & vbCrLf & _
        "Salesperson"
End Sub

0

Featured Post

How Blockchain Is Impacting Every Industry

Blockchain expert Alex Tapscott talks to Acronis VP Frank Jablonski about this revolutionary technology and how it's making inroads into other industries and facets of everyday life.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
The new Microsoft OS looks great, is easier than ever to upgrade to, it is even free.  So what's the catch?  If you don't change the privacy settings, Microsoft will, in accordance with the (EULA) you clicked okay to without reading, collect all the…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Suggested Courses

670 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question