I am new to vba and a co-worker has given me a piece of code and I would like to be able to add a new message line that will allow for the copying of a worksheet (ToolChange) to be hyperlinked and sent to an individual as an email. Can this be done?
Private Sub SendStartUpEmail() pCheck On Error Resume Next Dim refstart As String, refend As String Windows(dbook).Activate Dept = Sheets("Info").Range("B8") strMail(1) = "<html><body>" strMail(2) = "The following file was just opened on computer: " & Comp & "<br>" strMail(3) = PN & " Op " & op & " " & so & "<br>" strMail(4) = "Dept: " & Dept & "<br>" strMail(5) = "<br>" strMail(6) = "Please ensure that all tooling and paperwork is ready for this operation." & "<br>" strMail(7) = "Documentation may be found at the link below.<br>" If UCase(Sheets("Info").Range("A19")) = "TOOL" And Sheets("Info").Range("B19") <> "" Then strMail(8) = "Program/Tooling Sheets may be found at the link below.<br>" End If If LotC Then strMail(5) = "<font color=Blue> This is a Lot Change Only </Font><br>" End If CreateEmail: Dim objFSO As Object Dim objFile As Object Dim objFolder As Object Dim writefile As String Dim f As Integer writefile = "C:\Blat\Output.TXT" On Error GoTo PermissionsError If FileExists(writefile) Then Kill writefile If FileExists(writefile) Then 'we have a permissions error that didn't get trapped If Plant = "MAT" Then MsgBox "Unable to send notification email. Please HotButton Tim and inform him." Else MsgBox "Unable to send notification email. Please HotButton Brandy and inform her." End If Application.Run "Errors.ErrorLog", "eData", Err.Number, Err.Description, 1 End If 'Exit Sub On Error GoTo EmailError Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.getfolder("C:\Blat") Set objFile = objFSO.OpenTextFile(writefile, 2, True, 0) For x = 1 To 10 objFile.WriteLine strMail(x) Next objFile.Write "<a href=""" objFile.Write OV objFile.Write """>" objFile.Write OV objFile.WriteLine "</a><br>" If Plant = "MFG" Then Dim DV As String 'Full path of tool sheet DV = Sheets("Info").Range("B19") objFile.Write "<a href=""" objFile.Write DV objFile.Write """>" objFile.Write DV objFile.WriteLine "</a><br>" End If objFile.WriteLine "</body></html>" objFile.Close Set objFile = Nothing Set objFolder = Nothing Set objFSO = Nothing On Error GoTo 0 Application.DisplayAlerts = False Application.DisplayAlerts = True On Error GoTo SendMailError Select Case Plant Case "MAT" 'Dept = "Test" Select Case UCase(Dept) Case "CFG" Shell ("""C:\Blat\Blat.exe"" ""c:\blat\output.txt"" -server 192.168.1.3 -tf ""Y:\Quality\EmailLists\OVL_Open_CFG.txt"" -subject ""OVL / Operation Begun"" -f rusht@moelleraerospace.com -html") Case "EDM" Shell ("""C:\Blat\Blat.exe"" ""c:\blat\output.txt"" -server 192.168.1.3 -tf ""Y:\Quality\EmailLists\OVL_Open_EDM.txt"" -subject ""OVL / Operation Begun"" -f rusht@moelleraerospace.com -html") Case "MILL" Shell ("""C:\Blat\Blat.exe"" ""c:\blat\output.txt"" -server 192.168.1.3 -tf ""Y:\Quality\EmailLists\OVL_Open_Mill.txt"" -subject ""OVL / Operation Begun"" -f rusht@moelleraerospace.com -html") Case "LATHE" Shell ("""C:\Blat\Blat.exe"" ""c:\blat\output.txt"" -server 192.168.1.3 -tf ""Y:\Quality\EmailLists\OVL_Open_Lathe.txt"" -subject ""OVL / Operation Begun"" -f rusht@moelleraerospace.com -html") Case "5X" Shell ("""C:\Blat\Blat.exe"" ""c:\blat\output.txt"" -server 192.168.1.3 -tf ""Y:\Quality\EmailLists\OVL_Open_5x.txt"" -subject ""OVL / Operation Begun"" -f rusht@moelleraerospace.com -html") Case "VTL" Shell ("""C:\Blat\Blat.exe"" ""c:\blat\output.txt"" -server 192.168.1.3 -tf ""Y:\Quality\EmailLists\OVL_Open_VTL.txt"" -subject ""OVL / Operation Begun"" -f rusht@moelleraerospace.com -html") Case "CELL" Shell ("""C:\Blat\Blat.exe"" ""c:\blat\output.txt"" -server 192.168.1.3 -tf ""Y:\Quality\EmailLists\OVL_Open_Cell.txt"" -subject ""OVL / Operation Begun"" -f rusht@moelleraerospace.com -html") Case "TEST" Shell ("""C:\Blat\Blat.exe"" ""c:\blat\output.txt"" -server 192.168.1.3 -t tdr@harborsprings.local -subject ""TEST OVL / Operation Begun"" -f rusht@moelleraerospace.com -html") End Select Case "MFG" Shell ("""C:\Blat\Blat.exe"" ""c:\blat\output.txt"" -server 92.92.92.12 -tf ""y:\quality\EmailLists\newovllist.txt"" -subject ""OVL / Operation Begun"" -f aircraft@moeller.com -html") Sleep (3000) End Select On Error GoTo PermissionsError If FileExists(writefile) Then Kill writefile If FileExists(writefile) Then 'we have a permissions error that didn't get trapped If Plant = "MAT" Then MsgBox "Unable to send notification email. Please HotButton Tim and inform him." Else MsgBox "Unable to send notification email. Please HotButton Brandy and inform her." End If Application.Run "Errors.ErrorLog", "eData", Err.Number, Err.Description, 1 End If ExitHere: Exit Sub
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks