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
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
