• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to attach a file(spreadsheet) to the email I have created in the code below vba excel?

juan villa

New Member
Code:
Sub SendEMail()
  Dim r As Integer, x As Double
  Dim quote As String
  quote = Chr(34)
  For r = 2 To 4 'data in rows 2-4
'  Get the email address
  Email = Cells(r, 3)
   
'  Message subject
  Subj = "PC refresh notification :Asset:" & Cells(r, 4)

'  Compose the message
  Msg = "Dear " & Cells(r, 2) & "," & vbCrLf & vbCrLf
   
  Msg = Msg & "The asset listed in the subject line above is assigned to you and is due for refresh. Please provide me via" & vbCrLf
  Msg = Msg & "reply to this email your model preference.  Model options are:" & vbCrLf & vbCrLf
   
  Msg = Msg & "Standard laptop (standard model for all users)" & vbCrLf
  Msg = Msg & "Standard desktop (production / tire building floor PCs)" & vbCrLf
  Msg = Msg & "Engineering laptop (for qualifying users - see below)" & vbCrLf
  Msg = Msg & "SEngineering desktop (for qualifying users only)" & vbCrLf & vbCrLf

  Msg = Msg & "For engineering models:" & vbCrLf
  Msg = Msg & "In order to proceed with " & quote & "refreshing" & quote & " to a newer model of engineering PC, you will want to provide a list of " & vbCrLf
  Msg = Msg & "software applications you are currently using which you feel qualify you for an engineering machine. If " & vbCrLf
  Msg = Msg & "your response falls within the Group parameters, then it will be documented and your machine can be " & vbCrLf
  Msg = Msg & "refreshed to the latest engineering model. Otherwise, your machine will be refreshed to the standard model PC." & vbCrLf & vbCrLf
   
  Msg = Msg & "For more than one PC assignment:" & vbCrLf
  Msg = Msg & "This is the second PC assigned to you.  You must provide a justification for the second PC.  It your " & vbCrLf
  Msg = Msg & "response falls within the Group parameters, then your model selection will be processed.  Otherwise, the PC must be turned in." & vbCrLf & vbCrLf
   
  Msg = Msg & "Many thanks for your attention to this matter." & vbCrLf & vbCrLf
   
'  Replace spaces with %20 (hex)
  Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
  Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
   
'  Replace carriage returns with %0D%0A (hex)
  Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

'  Create the URL
  URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'  Execute the URL (start the email client)
  ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'  Wait two seconds before sending keystrokes
  Application.Wait (Now + TimeValue("0:00:02"))
  Application.SendKeys "%s"
  Next r
End Sub
 
Back
Top