How JustAnswer Works:

  • Ask an Expert
    Experts are full of valuable knowledge and are ready to help with any question. Credentials confirmed by a Fortune 500 verification firm.
  • Get a Professional Answer
    Via email, text message, or notification as you wait on our site.
    Ask follow up questions if you need to.
  • 100% Satisfaction Guarantee
    Rate the answer you receive.

Ask Brandon M. Your Own Question

Brandon M.
Brandon M., Web Designer
Category: Programming
Satisfied Customers: 6976
Experience:  Web Design for 10 years, HTML, XML, PHP/MySQL, Perl, JavaScript, CSS
12024030
Type Your Programming Question Here...
Brandon M. is online now
A new question is answered every 9 seconds

I have a macro to email files from Excel. The files at the

Resolved Question:

I have a macro to email files from Excel. The files at the specific location attach fine. I need to attach a file based on a cell location in the workbook. How do I do that?
Submitted: 1 year ago.
Category: Programming
Expert:  Brandon M. replied 1 year ago.

BeBoo :

Hello and thank you for contacting JustAnswer, a paid expert support site. My name is XXXXX XXXXX I'd be glad to assist you with your issue.

BeBoo :

So, in F2, you have a path (C:\...\...\) to a file, correct?

Customer:

That is correct.

BeBoo :

Ok, just a second. This should be pretty easy.

BeBoo :

Try: .Attachments.Add = Sheets("Sheet1").Range("F2").Text

BeBoo :

Replacing the "Sheet1" with your sheet name

Customer:

It did not work.

BeBoo :

Ok, we may need an actual file object. Just a sec.

Customer:

The macro splits sheet1 into seperate sheets based on the user emails address then emails the worksheet to user.

BeBoo :

Ah ok, so are you taking into account the new sheet, then?

Customer:

Yes

BeBoo :

Just for giggles, you might want to do an MsgBox for that value (Sheets("Sheet1").Range("F2").Text) and make sure it is the correct path.

Customer:

Not sure what you mean on that one

BeBoo :

To make sure you are getting the right path.

BeBoo :

You can do MsgBox Sheets("Sheet1").Range("F2").Text

BeBoo :

and it will popup an alert box with that value. If you have the right cell/sheet, it should have the path in it.

BeBoo :

If you think it might help, you can send me the sheet so I can see exactly what you are trying to do.

Customer:

did you receive the file?

BeBoo :

Where is the macro? In Outlook?

Customer:

No Excel

BeBoo :

I don't see a Macro on this document

Customer:

Sub Split_Worksheets()
'Note: This macro use the function LastRow
Dim My_Range As Range
Dim FieldNum As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim ws2 As Worksheet
Dim Lrow As Long
Dim cell As Range
Dim CCount As Long
Dim WSNew As Worksheet
Dim ErrNum As Long


'Set filter range on ActiveSheet: A1 is the top left cell of your filter range
'and the header of the first column, D is the last column in the filter range.
'You can also add the sheet name to the code like this :
'Worksheets("Sheet1").Range("A1:K" & LastRow(Worksheets("Sheet1")))
'No need that the sheet is active then when you run the macro when you use this.
Set My_Range = Range("A1:F5") ' & LastRow(ActiveSheet))
My_Range.Parent.Select


If ActiveWorkbook.ProtectStructure = True Or _
My_Range.Parent.ProtectContents = True Then
MsgBox "Sorry, not working when the workbook or worksheet is protected", _
vbOKOnly, "Copy to new worksheet"
Exit Sub
End If


'This example filters on the tenth column in the range(change the field if needed)
'In this case the range starts in A so Field:=1 is column A, 2 = column B, ......
FieldNum = 5 ' I changed this to 5 for column E


'Turn off AutoFilter
My_Range.Parent.AutoFilterMode = False


'Change ScreenUpdating, Calculation, EnableEvents, ....
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False


'Add a worksheet to copy the a unique list and add the CriteriaRange
Set ws2 = Worksheets.Add


With ws2
'first we copy the Unique data from the filter field to ws2
My_Range.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True


'loop through the unique list in ws2 and filter/copy to a new sheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)


'Filter the range
My_Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _
Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?")


'Check if there are no more then 8192 areas(limit of areas)
CCount = 0
On Error Resume Next
CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible) _
.Areas(1).Cells.Count
On Error GoTo 0
If CCount = 0 Then
MsgBox "There are more than 8192 areas for the value : " & cell.Value _
& vbNewLine & "It is not possible to copy the visible data." _
& vbNewLine & "Tip: Sort your data before you use this macro.", _
vbOKOnly, "Split in worksheets"
Else
'Add a new worksheet
Set WSNew = Worksheets.Add(After:=Sheets(Sheets.Count))
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number > 0 Then
ErrNum = ErrNum + 1
WSNew.Name = "Error_" & Format(ErrNum, "0000")
Err.Clear
End If
On Error GoTo 0


'Copy the visible data to the new worksheet
My_Range.SpecialCells(xlCellTypeVisible).Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
' Remove this line if you use Excel 97
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
End If


'Show all data in the range
My_Range.AutoFilter Field:=FieldNum


Next cell


'Delete the ws2 sheet
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0


End With


'Turn off AutoFilter
My_Range.Parent.AutoFilterMode = False


If ErrNum > 0 Then
MsgBox "Rename every WorkSheet name that start with ""Error_"" manually" _
& vbNewLine & "There are characters in the name that are not allowed" _
& vbNewLine & "in a sheet name or the worksheet already exist."
End If


'Restore ScreenUpdating, Calculation, EnableEvents, ....
My_Range.Parent.Select
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With


MsgBox ("Copy Complete - - Remember to save your work.")



End Sub


 



Sub Email_MAH()
'Working in 2000-2010
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object


For Each sht In ActiveWorkbook.Sheets
sht.Activate
SendTo = sht.Range("E2").Value

Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:E2").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, " & _
"please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With


Set wb = ActiveWorkbook


Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = sht.Name & " " _
& Format(Now, "mm-dd-yyyy")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010
FileExtStr = ".xls": FileFormatNum = 56
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = SendTo
.From = ""
.CC = ""
.BCC = ""
.Subject = "Master Account Holder - ACTION REQUIRED"
.Body = "The Southeastern Kidney Council (SKC) distributes the Near Match report based on data reported by the CROWNWeb contractor in charge of batch submission. Errors prohibited the following patient data from your EMR (Electronic Medical Record) system from loading into CROWNWeb. Patient records must match exactly for the following identifiers: HIC, SSN, last name, first name, gender and DOB. The system rejects patient records that do not match the six identifiers. The Near Match Report contains patients with incorrect data. For each patient update your corporate system with the CROWNWeb value for records noted incorrect. Attached are instructions to resolve the error and admit the patient to CROWNWeb."
.Attachments.Add = Sheets("Sheet1").Range("F2").Text
'You can add other files also like this
.Attachments.Add ("I:\Aim 3 Improve Care to Reduce Cost\Quality Incentive Program (QIP)\MAH Folder\Detailed Facility Instructions.pdf")
.Attachments.Add ("I:\Aim 3 Improve Care to Reduce Cost\Quality Incentive Program (QIP)\MAH Folder\Instructions for Setting Up Corporate Account of Your Dialysis Organization.pdf")
.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Next
End Sub



BeBoo :

Ah, sorry! .Attachments.Add (Sheets("Sheet1").Range("F2").Text)

BeBoo :

not equals... Haha

Customer:

The file is still not attached. It attached the 2 files with the file path but not this one.

BeBoo :

Ok, just before that, put this: MsgBox (Sheets("Sheet1").Range("F2").Text)

BeBoo :

Does a box popup with I:\Aim 3 Improve Care to Reduce Cost\Quality Incentive Program (QIP)\MAH Folder\WebAccess\WebAccess_110038.pdf in it?

Customer:

The box is blank.

BeBoo :

Ok, that is why. It isn't getting the path from that field.

BeBoo :

Is that macro run from within this excel sheet?

Customer:


The path in field F2 =








I:\Aim 3 Improve Care to Reduce Cost\Quality Incentive Program (QIP)\MAH Folder\WebAccess\WebAccess_110016.pdf
Customer:

Again, the Sheet1 was split into workbooks based on the email addres. So each worksheet has the correct path in field F2. Some how we need to loop thru the worksheets.

BeBoo :

Right, but what I had you do it give a msgbox to make sure that the script can get that value.

Customer:

OK

BeBoo :

Well, the sheet would be named the email address, right?

Customer:

Yes

BeBoo :

If so, try this instead: MsgBox (Sheets(SendTo).Range("F2").Text)

BeBoo :

The email goes to that email address, correct?

Customer:

Yes. Change the current message box or add a new one?

BeBoo :

Change it

Customer:

No message appears and only the 2 files are attached.

BeBoo :

Hrm, that is odd, it should still appear blank if anything.

Customer:

I ran in 3 times.

BeBoo :

Ohh, I see - it's in a For Loop. We need to do this:

BeBoo :

Replace the one before with: MsgBox (sht.Range("F2").Value)

BeBoo :

Anything this time?

Customer:

Now, I get a box with the file location.

BeBoo :

Perfect!

BeBoo :

Replace it with this, then: .Attachments.Add (sht.Range("F2").Value)

Customer:

Okay, it worked but each record received 2 emails. One email contained the 3 documents an the other only contained 2.

BeBoo :

So, the second email didn't attach the file in F2?

Customer:

Yes the second email did attach the file

BeBoo :

It did? Maybe I am not understanding.

BeBoo :

Each record received two emails?

Customer:

I removed the message box and everything is okay now. Thanks!

BeBoo :

Ah, ok. Good.

BeBoo :

No problem!

Customer:

Thanks!

BeBoo :

I hope I have been helpful in today's session. It has been a pleasure working with you. Please be sure to rate the service you received today. You may also provide a tip after rating, if you feel I deserve one (thank you in advance!). Should you wish to request me in the future, you can bookmark/favorite my profile page by clicking my name on the left. Have a great rest of your day.

Brandon M., Web Designer
Category: Programming
Satisfied Customers: 6976
Experience: Web Design for 10 years, HTML, XML, PHP/MySQL, Perl, JavaScript, CSS
Brandon M. and 3 other Programming Specialists are ready to help you

JustAnswer in the News:

 
 
 
Ask-a-doc Web sites: If you've got a quick question, you can try to get an answer from sites that say they have various specialists on hand to give quick answers... Justanswer.com.
JustAnswer.com...has seen a spike since October in legal questions from readers about layoffs, unemployment and severance.
Web sites like justanswer.com/legal
...leave nothing to chance.
Traffic on JustAnswer rose 14 percent...and had nearly 400,000 page views in 30 days...inquiries related to stress, high blood pressure, drinking and heart pain jumped 33 percent.
Tory Johnson, GMA Workplace Contributor, discusses work-from-home jobs, such as JustAnswer in which verified Experts answer people’s questions.
I will tell you that...the things you have to go through to be an Expert are quite rigorous.
 
 
 

What Customers are Saying:

 
 
 
  • My Expert answered my question promptly and he resolved the issue totally. This is a great service. I am so glad I found it I will definitely use the service again if needed. One Happy Customer New York
< Last | Next >
  • My Expert answered my question promptly and he resolved the issue totally. This is a great service. I am so glad I found it I will definitely use the service again if needed. One Happy Customer New York
  • Wonderful service, prompt, efficient, and accurate. Couldn't have asked for more. I cannot thank you enough for your help. Mary C. Freshfield, Liverpool, UK
  • This expert is wonderful. They truly know what they are talking about, and they actually care about you. They really helped put my nerves at ease. Thank you so much!!!! Alex Los Angeles, CA
  • Thank you for all your help. It is nice to know that this service is here for people like myself, who need answers fast and are not sure who to consult. GP Hesperia, CA
  • I couldn't be more satisfied! This is the site I will always come to when I need a second opinion. Justin Kernersville, NC
  • Just let me say that this encounter has been entirely professional and most helpful. I liked that I could ask additional questions and get answered in a very short turn around. Esther Woodstock, NY
  • Thank you so much for taking your time and knowledge to support my concerns. Not only did you answer my questions, you even took it a step further with replying with more pertinent information I needed to know. Robin Elkton, Maryland
 
 
 

Meet The Experts:

 
 
 
  • ATLPROG

    Computer Software Engineer

    Satisfied Customers:

    7463
    MS in IT.Several years of programming experience in Java C++ C C# Python VB Javascript HTML
< Last | Next >
  • http://ww2.justanswer.com/uploads/SP/spatlanta2010/2011-6-23_12450_photo.64x64.gif ATLPROG's Avatar

    ATLPROG

    Computer Software Engineer

    Satisfied Customers:

    7463
    MS in IT.Several years of programming experience in Java C++ C C# Python VB Javascript HTML
  • http://ww2.justanswer.com/uploads/ComputersGuru/2010-02-13_051118_Photo41.JPG LogicPro's Avatar

    LogicPro

    Computer Software Engineer

    Satisfied Customers:

    5603
    Expert in C, C++, Java, DOT NET, Python, HTML, Javascript, Design.
  • http://ww2.justanswer.com/uploads/unvadim/2010-11-15_210218_avatar.jpg unvadim's Avatar

    unvadim

    Computer Software Engineer

    Satisfied Customers:

    1158
    Good knowledge of OOP principles. 3+ years of programming experience with Java and C++. Sun Certified Java Programmer 5.0.
  • http://ww2.justanswer.com/uploads/lifesaver333/2010-10-17_191349_ls.jpeg lifesaver's Avatar

    lifesaver

    Computer Software Engineer

    Satisfied Customers:

    950
    Several years of intensive programming and application development experience in various platforms.
  • http://ww2.justanswer.com/uploads/EH/ehabtutor/2012-8-2_202016_1.64x64.jpg ehabtutor's Avatar

    ehabtutor

    Computer Software Engineer

    Satisfied Customers:

    864
    Bachelor of computer science, 5+ years experience in software development, software company owner
  • http://ww2.justanswer.com/uploads/RA/rajivsharma086/2012-6-6_17128_displaypic.64x64.jpg Raj's Avatar

    Raj

    Computer Engg.

    Satisfied Customers:

    860
    BE CS, 4+ Experience in Programming and Database (ERP)
  • http://ww2.justanswer.com/uploads/eljonis/2010-01-06_130406_eljon2.jpg Eljon's Avatar

    Eljon

    Consultant

    Satisfied Customers:

    590
    11 yrs of programming (PHP, WordPress, XSL, SQL, JavaScript)
 
 
 

Related Programming Questions