Adding path of folder in email (1 Viewer)

[megatronixs]

Hi all,

I have some code that takes data from my database and creates an email with it. It also creates a folder and a word document. In the email, I would also like to include the file path as a link instead of just the path that it puts there now. Is this possible to do?

Please see my current code:

Option Compare Database

Private Sub SendEmail_Click()

On Error GoTo Err_open_word_Click



    Dim oApp As Object
    Dim path As String
    Dim filename As String
    Dim strEventPhotos As String
    
    'adding variable with path and file name, adding another backslash at the end of path
    path = "Y:\Developement\Ulster Bank\Folders\" & Me.BINnr & "_" & Me.CompanyName & "_" & Me.Analyst & "\"
    filename = Me.BINnr & Me.CompanyName & Me.Analyst & ".doc"
    
    'checking if the folder exist if not creating one
    If Dir(path, vbDirectory) = vbNullString Then
    MkDir path
    End If
    strEventPhotos = "Y:\Developement\Ulster Bank\Folders\" & Me.BINnr & "_" & Me.CompanyName & "_" & Me.Analyst
    Shell "EXPLORER.EXE " & strEventPhotos, vbNormalFocus
    Set oApp = CreateObject("Word.Application")
    oApp.Visible = True
    oApp.Documents.Add
    'oApp.activedocument.SaveAs filename:=path & filename
    If Dir(path & filename) = "" Then
        oApp.activedocument.SaveAs filename:=path & filename
    Else
        'MsgBox "File already exist!"
        oApp.Quit
    End If
Debug.Print path
    
    
Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim olApp As Outlook.Application
    Dim objMail As Outlook.MailItem
    
    Dim strTableBeg As String
    Dim strTableBody As String
    Dim strTableEnd As String
    Dim strFntNormal As String
    Dim strTableHeader As String
    Dim strFntEnd As String
        
    Dim dblTotGross As Double
    Dim dblTotCommission As Double

    'Define format for output
    strTableBeg = "<br><br><table border=1 cellpadding=3 cellspacing=0>"
    strTableEnd = "</table>Dear analyst,<br><br>Please note that a new case has been assigned to you.<br>Please find below the link:<br><br><br>Regards. <br><br>Path: " & path
    strTableHeader = "<font size=3 face=" & Chr(34) & "Verdana" & Chr(34) & "><b>" & _
                        "<tr bgcolor=lightblue>" & _
                            TD("BIN") & _
                            TD("CompanyName") & _
                            TD("Analyst") & "</tr></b></font>"
'                            TD("Trans Type") & _
'                            TD("Effective Date") & _
'                            TD("Gross") & _
'                            TD("Commission") & _
'                            TD("Net") & _

    strFntNormal = "<font color=black face=" & Chr(34) & "Verdana" & Chr(34) & " size=2>"
    strFntEnd = "</font>"
    
    strSQL = "SELECT * FROM TARA WHERE Email = True"
    Set rst = CurrentDb.OpenRecordset(strSQL)
    
    'Build HTML Output for the DataSet
    strTableBody = strTableBeg & strFntNormal & strTableHeader
    
    
    Do Until rst.EOF
        strTableBody = strTableBody & _
                        "<tr>" & _
                            TD("BINnr") & _
                            TD("CompanyName") & _
                            TD("Analyst") & "</tr>"
'                            TD(rst!TranType) & _
'                            TD(rst!BillEffDte) & _
'                            TD(Format(rst!Gross, "currency")) & _
'                            TD(Format(rst!Comm, "currency")) & _
'                            TD(Format(rst!Net, "currency")) & _
                        "</tr>"
''        dblTotGross = dblTotGross + rst!Gross
'        dblTotCommission = dblTotCommission + CDbl(rst!Comm)
        
        rst.MoveNext
    Loop

    'Totals
'    strTableBody = strTableBody & _
                    "<tr><TD align=right colspan=5 nowrap><b>Totals</td></b>"
'                    & _
'                        TD (Format(dblTotGross, "BINnr")) & TD(Format(dblTotCommission, "BINnr")) & "</tr>"
'                        TD(Format(dblTotGross + dblTotCommission, "currency")) &
                    
    
    'strTableBody = strTableBody & strFntEnd & strTableEnd
    strTableBody = strFntEnd & strTableEnd & strTableBody
    
    rst.Close
    
    'Create e-mail item
    Set olApp = Outlook.Application
    Set objMail = olApp.CreateItem(olMailItem)
    With objMail
        'Set body format to HTML
        .To = " "
        .Subject = "New Case has been assigned to you "
        .BodyFormat = olFormatHTML
        '.HTMLBody = "<HTML><BODY>" & strFntNormal & strTableBody & " </BODY></HTML>"   'original
        .HTMLBody = "<HTML><BODY>" & strTableBody & strFntNormal & " </BODY></HTML>"
        .Display
    End With
    
Clean_Up:
    Set rst = Nothing
    
Exit_open_word_Click:
    Exit Sub

Err_open_word_Click:
    MsgBox Err.Description
    Resume Exit_open_word_Click

Debug.Print path

End Sub

Greetings.

 

[megatronixs]

Hi all,

I found a link where they have info over it. It is working now for me.

http://datapigtechnologies.com/blog...l-with-a-link-to-a-workbook-on-a-share-drive/

Greetings.