mcelligott
Programmer
I have been using the following VB code successfully to send an e-mail via Lotus Notes with the current Excel spreadsheet as an attachment. Now I need to be able to send a second attachment in the e-mail but I need the user to have a dialog box open so they are able to choose the file to send. It will always be an Excel file but the file name is never the same but always resides in the same folder. Can anyone point me in the correct direction?
Thanks,
Bob
Thanks,
Bob
Code:
Sub EMail()
'
' EMail Macro
' Copies the worksheet and sends it to e-mail
'
'==Create the variables
Dim strDate As String
Dim response As String
Dim response2 As String
Dim objNet
Dim CurVer As Integer
Dim NextVer As Integer
'==Preset some of the variables values
strDate = Format(ActiveSheet.Range("K1"), "mm-dd-yyyy")
Set objMessage = CreateObject("CDO.Message")
Set objNet = CreateObject("WScript.NetWork")
CurVer = ActiveSheet.Range("Z1").Value
NextVer = ActiveSheet.Range("Z1").Value + 1
'==Increments the version number of the report located in cell Z1
ActiveSheet.Range("Z1").Value = NextVer
'==Determines if the report is new or a revision and saves the End of Shift Report to the server with the date and revision # if applicable
Application.DisplayAlerts = False
If NextVer = 1 Then
ActiveWorkbook.SaveCopyAs Filename:="\\ecd911\Project\CAD\Newsletters\SME Updates\SME Update for " & strDate & ".xls"
Else
ActiveWorkbook.SaveCopyAs Filename:="\\ecd911\Project\CAD\Newsletters\SME Updates\SME Update for " & strDate & " ver " & NextVer & ".xls"
End If
Application.DisplayAlerts = True
'==Prepares e-mail
'==Sets the Subject field
If NextVer = 1 Then
objMessage.Subject = "SME Update Report for " & strDate
Else
objMessage.Subject = "SME Update Report for " & strDate & " ver " & NextVer
End If
'==Sets the From field
objMessage.From = "SMEUpdateReport@monroecounty.gov"
'==This is primarily used for testing purposes to override sending it to everyone on the distribution list
'response2 = InputBox("Please enter an e-mail address you would like to test sending this to (ex: asmith@monroecounty.gov)", "Enter E-mail address")
'==Sets the To field (use the first one for testing purposes or the second one for production, do NOT use both at the same time)
'objmessage.To = response2
objMessage.To = "bmcelligott@monroecounty.gov"
'==Sets the Body field
'objMessage.TextBody = "SME Update sent by: " & objNet.UserName & Chr(13) & Chr(13) & "Please do not reply to the sending address." & Chr(13) & Chr(13)
objMessage.To = "bmcelligott@monroecounty.gov"
'==Sets the Attachment
If NextVer = 1 Then
objMessage.addattachment "\\ecd911\Project\CAD\Newsletters\SME Updates\SME Update for " & strDate & ".xls"
Else
objMessage.addattachment "\\ecd911\Project\CAD\Newsletters\SME Updates\SME Update for " & strDate & " ver " & NextVer & ".xls"
End If
'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item _
("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
'==Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = "SMTP.mc.ad.monroecounty.gov"
'==Server port (typically 25)
objMessage.Configuration.Fields.Item _
("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
'==Sends the e-mail
objMessage.Send
'==Prints the End of Shift Report to the default printer
ActiveSheet.PrintOut
'==Displays a message box to the user to confirm the e-mail was sent
response = MsgBox("A copy of your SME Update report has been saved and sent to the distribution list", vbOKOnly, "Confirmation")
'==Destroy the Object to free the Memory
Set objNet = Nothing
'==Closes excel without overwriting the current version
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.Quit
Application.DisplayAlerts = True
out1:
End Sub