Hey eric,
ok heres the code
code for command button to send email
************************************************************
Private Sub cmdSend_Click()
On Error GoTo Err_cmdSend_Click
Dim lngCurrentRow As Integer
Dim strTo As String
Dim strCC As String
Dim strBCC As String
Dim strAttach As String
Dim bOK As Boolean
If Me.Subject = STR_NULL1 Or IsNull(Me.Subject) Then
MsgBox "You have not entered a valid subject.",
vbCritical + vbOKOnly, "Error"
Exit Sub
End If
If Me.MessageText = STR_NULL1 Or IsNull(Me.MessageText)Then
MsgBox "You have not entered a valid message.", vbCritical + vbOKOnly, "Error"
Exit Sub
End If
strAttach = txtAttachment
If Me.txtAttachment = STR_NULL1 Or IsNull(Me.txtAttachment) Then
MsgBox "Note you did not attach any files.", vbOKOnly
Exit Sub
End If
For lngCurrentRow = 0 To lstTo.ListCount - 1
If lngCurrentRow = 0 Then
strTo = lstTo.Column(0, lngCurrentRow)
Else
strTo = strTo & ";" & lstTo.Column(0, lngCurrentRow)
End If
Next lngCurrentRow
If strTo = STR_NULL1 Or IsNull(strTo) Then
MsgBox "You have not entered a valid recipient address.", vbCritical + vbOKOnly, "Error"
Exit Sub
End If
For lngCurrentRow = 0 To lstCC.ListCount - 1
If lngCurrentRow = 0 Then
strCC = lstCC.Column(0, lngCurrentRow)
Else
strCC = strCC & ";" & lstCC.Column(0, lngCurrentRow)
End If
Next lngCurrentRow
For lngCurrentRow = 0 To lstBCC.ListCount - 1
If lngCurrentRow = 0 Then
strBCC = lstBCC.Column(0, lngCurrentRow)
Else
strBCC = strBCC & ";" & lstTo.Column(0, lngCurrentRow)
End If
Next lngCurrentRow
Call SendMsg(Me.Subject, Me.MessageText, strTo, strCC, strBCC, strAttach)
Exit_cmdSend_Click:
Exit Sub
Err_cmdSend_Click:
MsgBox err.Description
Resume Exit_cmdSend_Click
End Sub
************************************************************
code for the attachment button
************************************************************
Private Sub cmdBrowse_Click()
On Error GoTo err_cmdBrowse
Me.txtAttachment = GetOpenFile_CLT("C:\", "Select a File to Attach.")
Me.txtAttachment = LCase(Me.txtAttachment)
If Me.txtAttachment <> STR_NULL1 And Not IsNull(Me.txtAttachment) Then
Me.txtAttachmentAlias.Enabled = True
Me.txtAttachmentAlias.SetFocus
Else
Me.txtAttachmentAlias.Enabled = False
End If
exit_cmdBrowse:
Exit Sub
err_cmdBrowse:
MsgBox err.Description
Resume exit_cmdBrowse
End Sub
************************************************************
code for module that has function GetOpenFile_CLT
Function GetOpenFile_CLT(strInitialDir As String, strTitle As String) As String
' Comments : Simple file open routine. For additional options, use GetFileOpenEX_CLT()
' Parameters: strInitialDir - path for the initial directory, or blank for the current directory
' strTitle - title for the dialog
' Returns : string path, name and extension of the file selected
'
Dim fOK As Boolean
Dim typWinOpen As CLTAPI_WINOPENFILENAME
Dim typOpenFile As CLTAPI_OPENFILE
Dim strFilter As String
On Error GoTo PROC_ERR
' Set reasonable defaults for the structure
strFilter = CreateFilterString_CLT("All Files (*.*)", "*.*")
If strInitialDir <> "" Then
typOpenFile.strInitialDir = strInitialDir
Else
typOpenFile.strInitialDir = CurDir()
End If
If strTitle <> "" Then
typOpenFile.strDialogTitle = strTitle
End If
typOpenFile.strFilter = strFilter
typOpenFile.lngFlags = OFN_HIDEREADONLY Or OFN_SHOWHELP
' Convert the CLT structure to a Win structure
ConvertCLT2Win typOpenFile, typWinOpen
' Call the Common dialog
fOK = CLTAPI_GetOpenFileName(typWinOpen)
' Convert the Win structure back to a CLT structure
ConvertWin2CLT typWinOpen, typOpenFile
GetOpenFile_CLT = typOpenFile.strFullPathReturned
PROC_EXIT:
Exit Function
PROC_ERR:
GetOpenFile_CLT = ""
Resume PROC_EXIT
End Function
************************************************************
module code for automation of outlook
************************************************************
Public Sub SendMsg(strSubject As String, _
strBody As String, _
strTo As String, _
strAttach As String, _
Optional strCC As String = STR_NULL1, _
Optional strBCC As String = STR_NULL1)
Dim oLapp As Outlook.Application
Dim oItem As Outlook.MailItem
Set oLapp = CreateObject("Outlook.Application")
Set oItem = oLapp.CreateItem(0)
With oItem
.Subject = strSubject
.To = strTo
.Attachments = strAttach
If Not IsMissing(strCC) And strCC <> STR_NULL1 Then
.CC = strCC
End If
If Not IsMissing(strBCC) And strBCC <> STR_NULL1 Then
.BCC = strBCC
End If
.Body = strBody
.Send
End With
Set oLapp = Nothing
Set oItem = Nothing
End Sub
************************************************************
