E-mail Files From Excel

[jaihawk8]

I am trying to write a script that will let me end enter a couple of pieces of information, click a button, and have Excel e-mail various reports to our Sales Reps.

Here is the file:

https://www.dropbox.com/s/yx4w8lhgykv8ni1/Email File.xlsm?dl=0

Here is the code that I have written:

Sub Send_email_fromexcel()
Dim Edress As String
Dim Subject As String
Dim Message As String
Dim Filename As String
Dim outlookapp As Object
Dim myAttachments As Object
Dim path As String
Dim lastrow As Integer
Dim Attachment As String
Dim x As Integer


x = 6
y = 2
Z = 3


Do While Sheet1.Cells(x, 1) <> ""


Set outlookapp = CreateObject("Outlook.Application")
Set outlookmailitem = outlookapp.createitem(0)
Set myAttachments = outlookmailitem.Attachments


path = Sheet1.Cells(y, 2)
Edress = Sheet1.Cells(x, 1)
Subject = Sheet1.Cells(x, 2)
Filename = Sheet1.Cells(x, 3)
Attachment = path + Filename


outlookmailitem.To = Edress
outlookmailitem.cc = ""
outlookmailitem.bcc = ""
outlookmailitem.Subject = Subject
outlookmailitem.body = Sheet1.Cells(Z, 2)


myAttachments.Add (Attachment)
outlookmailitem.display
outlookmailitem.send


lastrow = lastrow + 1
Edress = ""


x = x + 1


Loop


Set outlookapp = Nothing
Set outlookmailitem = Nothing




End Sub


The problem I am having is that when it Debugs, it is hanging on:

myAttachments.Add (Attachment)

If I manually change path to "C:\AU" it works just fine, but I need to be able to allow the user to change the path each month.

Thanks in advance for your help.

 

[Logit]

.
You will need to edit this macro for your purposes, but it works well as is. Email addresses are listed Sheet1 & Col A.
Attachments are listed in Col B for each listed email recipient.

Option Explicit


Sub Send_Email()


    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
    
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
        With OutLookMailItem
                .To = c.Value
                .CC = "Your CC here"
                .Subject = "Your Subject here"
                .HTMLBody = "Your Body content here"
                .Attachments.Add c.Offset(i, 1).Value
                .Display
                '.Send
        End With
    Next c


End Sub