I have a excel sheet which has Hyperlink on Column Y to open invoices in word document. I like to run a macro and open the invoice from the link convert to PDF and attach to an email.
Below code is for the invoice named MyReport.docx on desktop , so I like to change this code so that invoices comes from Column Y on Excel sheet.
Is it possible?
Sub AttachActiveSheetPDF_03() ' Copy this code to the module of any Excel's workbook. ' Prepare report/invoice in MyReport.doc or MyReport.docx and store it on Desktop ' This macro exports the report document to PDF and attaches that PDF to Outlook's email Dim IsOutlCreated As Boolean, IsWordCreated As Boolean, IsDocOpen As Boolean Dim DesktopPath As String, DocFile As String, PdfFile As String, Title As String, s As String Dim OutlApp As Object, WordApp As Object Dim i As Long Dim char As Variant Const wdExportFormatPDF = 17 ' --> Settings, change to suit Const WordDocument = "MyReport.doc" 'Title = Range("A1") & " " & Date Title = "PU: " & Date ' <-- End ofsettings ' Check WordDocument presence on Desktop DesktopPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop") DocFile = DesktopPath & "\" & WordDocument s = Dir(DocFile & "*") If s = "" Then MsgBox "Word Report file not found:" & vbLf & DocFile, vbExclamation, "Exit" Exit Sub End If DocFile = DesktopPath & "\" & s ' Define PDF filename in TEMP folder PdfFile = WordDocument i = InStrRev(PdfFile, ".", , vbTextCompare) If i > Len(PdfFile) - 6 Then PdfFile = Left(PdfFile, i - 1) For Each char In Split("? "" / \ < > * | :") PdfFile = Replace(PdfFile, char, "_") Next PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf" 'Debug.Print PdfFile ' Delete PDF file - for the case it was not deleted at debugging If Len(Dir(PdfFile)) Then Kill PdfFile ' Open WordDocument if it was not open previously On Error Resume Next Set WordApp = GetObject(, "Word.Application") If Err Then Set WordApp = CreateObject("Word.Application") IsWordCreated = True End If Err.Clear WordApp.ScreenUpdating = False With WordApp.Documents(s): End With IsDocOpen = Err = 0 On Error GoTo 0 'exit_ If Not IsDocOpen Then WordApp.Documents.Open Filename:=DocFile, ReadOnly:=IsWordCreated End If ' Export activedocument as PDF to the temporary folder WordApp.Documents(s).ExportAsFixedFormat OutputFileName:=PdfFile, ExportFormat:=wdExportFormatPDF ' Use already open Outlook if possible On Error Resume Next Set OutlApp = GetObject(, "Outlook.Application") If Err Then Set OutlApp = CreateObject("Outlook.Application") IsOutlCreated = True End If On Error GoTo 0 ' Prepare e-mail with PDF attachment With OutlApp.CreateItem(0) ' Prepare e-mail .Subject = Title '.To = "..." ' <-- Put email of the recipient here '.CC = "..." ' <-- Put email of 'copy to' recipient here .Body = "Hi," & vbLf & vbLf _ & "The invoice is attached in PDF file" & vbLf & vbLf _ & "Best Regards," & vbLf _ & Application.UserName & vbLf & vbLf .Attachments.Add PdfFile ' Try to send On Error Resume Next '.Send ' or use .Display ' Return focus to Excel's window Application.Visible = True If Err Then MsgBox "E-mail was not sent", vbExclamation ' Else 'MsgBox "E-mail successfully sent", vbInformation End If On Error GoTo 0 End With exit_: ' Delete the temporary PDF file If Len(Dir(PdfFile)) Then Kill PdfFile ' Close WordDocument if it was open via this macro If IsDocOpen Then WordApp.Documents(s).Close False Else WordApp.ScreenUpdating = True End If ' Close WordApp if it was open via this macro If IsWordCreated Then WordApp.Quit: Set WordApp = Nothing ' Try to quit Outlook if it was not previously open If IsOutlCreated Then OutlApp.Quit ' Release the memory of object variable ' Note: sometimes Outlook object can't be released from the memory Set OutlApp = Nothing If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number End Sub