I need VBA to save file and attach file to email based on conditional statements

jcrowe31

New Member
Joined
Sep 22, 2014
Messages
1
Good morning!


Well I've been handed the task of taking an Excel form that works well, but expanding it to be a hybrid form that will take care of other needs/forms as well.


The developer who created the original form no long works here, so I'm taking my rusty VB skills and trying to manipulate the form to do exactly what I need it to do. In additional to this challenge IT doesn't have another developer who is familar with VBA.


The original form used ActiveWorkbook.SaveAs to name the file that was created and then .Attachments.Add to attach the file to an email with Subject Line and email contact auto populated. Now, I've made some minor changes to this code and the form still works well, but it doesn't do everything I need it to do.


The new form I'm trying to create would involve a drop down list to confirm what type of form is being completed. I need the file name created to be conditional to what is selected in the drop down and then of course that specific file to be attached to the email. I would also want the subject line to change as well.

Can someone please look at my code to see if there is a way to make it work? Thank you very much in advance.


This is the original code from the original form that works well:




Sub Finish()
On Error Resume Next
Application.DisplayAlerts = False
x = Sheets(2).Cells(2, 14).Value
Sheets(1).Copy: ActiveSheet.Shapes(2).Delete: Cells.Copy: Cells(1, 1).PasteSpecial xlPasteValues: Application.CutCopyMode = False
Range(Columns(12), Columns(16)).Delete xlLeft: ActiveWorkbook.SaveAs "C:\Pickup Request.xls", FileFormat:=56
With CreateObject("Outlook.Application").CreateItem(0)
If Cells(8, 3).Value <> "" Then e1 = Cells(8, 3).Value
If Cells(9, 3).Value <> "" Then e2 = Cells(9, 3).Value
If Cells(8, 3).Value = "" Then .To = "XGS " & x Else .To = e1 & ";" & e2
.Attachments.Add "C:\Pickup Request.xls": .Subject = "Pickup Request - Pro " & Cells(11, 8).Value: .Display: End With
Application.Dialogs(xlDialogPrinterSetup).Show
With ActiveSheet.PageSetup: .PaperSize = xlPaperLetter: .LeftMargin = Application.InchesToPoints(0): .RightMargin = Application.InchesToPoints(0): End With
Range(Cells(1, 1), Cells(41, 10)).PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveWorkbook.Close False
Application.DisplayAlerts = True
End Sub


This is the new code that I'm attempting to make work, but I'm failing with each adjustment. I assume what I want to do can be done, but since I'm severly rusty at VB and I can't find anything similar when researching online, I need some assistance.


Sub Finish()
On Error Resume Next
Application.DisplayAlerts = False
x = Sheets(2).Cells(2, 14).Value
Sheets(1).Copy: ActiveSheet.Shapes(2).Delete: Cells.Copy: Cells(1, 1).PasteSpecial xlPasteValues: Application.CutCopyMode = False
Range(Columns(12), Columns(16)).Delete xlLeft:
If Cells(1, 4).Value = "Reconsignment" Then ActiveWorkbook.SaveAs "C:\Recon.xls", FileFormat:=56
If Cells(1, 4).Value = "Redelivery" Then ActiveWorkbook.SaveAs "C:\Redel.xls", FileFormat:=56
If Cells(1, 4).Value = "Reconsignment and Redelivery" Then ActiveWorkbook.SaveAs "C:\ReconandRedel.xls", FileFormat:=56
If Cells(1, 4).Value = "Stop Shipment Authorization" Then ActiveWorkbook.SaveAs "C:\StopShip.xls", FileFormat:=56
CreateObject("Outlook.Application").CreateItem (0)
If Cells(8, 3).Value <> "" Then e1 = Cells(8, 3).Value
If Cells(9, 3).Value <> "" Then e2 = Cells(9, 3).Value
If Cells(8, 3).Value = "" Then .To = "XGS Billing "
If Cells(8, 3).Value = "" Then .Cc = "Jamie Crowe "
.Attachments.Add
If Cells(1, 4).Value = "Reconsignment" Then .Attachments.Add "C:\Recon.xls": .Subject = "Recon - Pro " & Cells(11, 8).Value: .Body = "Please find attached Reconsignment Form.":.Display:
If Cells(1, 4).Value = "Redelivery" Then .Attachments.Add "C:\Redel.xls": .Subject = "Redel - Pro " & Cells(11, 8).Value: .Body = "Please find attached Redelivery Form.": .Display:
If Cells(1, 4).Value = "Reconsignment" Then .Attachments.Add "C:\ReconandRedel.xls": .Subject = "Recon and Redel - Pro " & Cells(11, 8).Value: .Body = "Please find attached Reconsignment and Redelivery Form.": .Display:
If Cells(1, 4).Value = "Stop Shipment Authorization" Then .Attachments.Add "C:\StopShip.xls": .Subject = "Stop Shipment - Pro " & Cells(11, 8).Value: .Body = "Please find attached Stop Shipment Form.": .Display: End With
ActiveWorkbook.Close False
End Sub
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,212
Messages
5,836,034
Members
430,401
Latest member
Kalleahlqvist

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top