Add Images

[DMT Dave]

Hi Guys,

Hope you can help with this one, i am trying to add an image or all images within folder to inside of the table of pallet data

when i call AppendPalletData, all data is adding but not images

hope i have explained correct!!





Kindest

Private Sub AppendPalletData(ByRef strBody As String)
Dim sBase As String, strStartTime As String, strEndTime As String, strFS As String, strFE As String, strEORI As String, strGross As String
Dim strSpan As String, strSpanEnd As String, strRef As String, strFontBlue As String, sDealer As String, strPalletSize As String, strTotalWgt As String, sPath As String, sFiles As String
Dim rs As DAO.Recordset
Dim lngPalletWgt As Long, lngTotalPalletWgt As Long
Dim iTotalItems As Integer, iPalletQty As Integer
Dim sDenDest As String, sColDest As String, strPC As String


strPC = DLookup("PostCode", "tblCollections", "[CollectNow] = Yes")
sDealer = DLookup("DelTo", "tblCollections", "[CollectNow] = Yes")
sBase = "Warehouse Postcode"


            
    sEndDest = "<a href='https://www.google.co.uk/maps/dir/" & Replace(strPC, " ", "") & "'>" & "View End Destination:" & "</a><br><br>"
    sColDest = "<a href='https://www.google.co.uk/maps/dir/" & Replace(sBase, " ", "") & "'>" & "View Collection Location:" & "</a>"
    
    strSpan = "<span style='background:yellow'>"
    strSpanEnd = "</span>"
    strFS = "<font size='3' face='arial' style='text-align=center'; vertical-align='middle'>" ' Mail Font
    strFE = "</font>" ' End Font'
    
    strBoxStart = "<script><table width='auto';style='text-align:left;border:1px solid black;font-family:arial;border-collapse:collapse;padding:10px'><tr style='background:white;mso-highlight:blue' ctx.shadowblur;20; ctx.shadowcolor;blue></script>"
    strBoxEnd = "</tr></table>"
    
    sFH = "<font size='4' face='Calibri' style='text-align=center; vertical-align='middle'>"
    sFHEnd = "</font>"


    strFontBlue = "<B><font color='blue'></B>"


'PALLET SIZES
    Set rs = CurrentDb.OpenRecordset("Select * From tblPalletsTemp")
    Do Until rs.EOF
        strPalletSize = strPalletSize & "<li> " & rs.Fields("Pallets") & "<br>"
        rs.MoveNext
    Loop
'EORI
    If Not IsNull(strEORI = DLookup("EORI", "tblDealers", "[PostCode] = '" & strPC & "'")) Then
        strEORI = DLookup("EORI", "tblDealers", "[PostCode] = '" & strPC & "'")
        Me.txtEORI = strEORI
    Else
        myEORI = "N/A"
    End If
'PALLET QTY / WEIGHTS
'Select Case Me.cboPallets


'Case Is > 0
strBody = strBody & sFH & "<B>" & "Pallet Dimensions / Location" & "</B>" & sFHEnd & "<br><br>"
''strBody = strBody & _


    lngPalletWgt = "20" ' EMPTY PALLET
    iTotalItems = Me.txtTotalBoxes ' TOTAL ITEMS
    strTotalWgt = "Estimated Total Nett Weight (Excl pallet): " & Me.txtTotalWeight & " " & "Kg's" 'TOTAL WEIGHT EXCL PALLET
    'iPalletQty = Me.cboPallets 'TOTAL QTY OF PALLETS
    iPalletQty = "1"
    lngTotalPalletWgt = lngPalletWgt * iPalletQty
    Me.txtGrossWeight = Left(lngTotalPalletWgt, 2) + Me.txtTotalWeight
    strGross = "Estimated Total Gross Weight (Incl pallet): " & Me.txtGrossWeight & " " & "Kg's"
    strSingleWgt = "Estimated Weight Per Pallet: " & Me.txtGrossWeight / iPalletQty & " " & "Kg's"
    
    strBody = strBody & _
    "<table width='50%'>" & _
    "<tr>" & _
    "<th style='color: White; background-color: rgb(0,0,139);border:1px solid black;font-family:arial;border-collapse:collapse;padding:8px'>Pallet Details</th></tr>"
    
    Select Case Me.optAddImages
    Case Is = False
    
    strBody = strBody & "<tr>" & _
                "<td style='background-color:#F5F5F5;border:1px solid black;font-family:arial;border-collapse:collapse;padding:8px'>" & _
                strFS & _
                        "<li>" & "Total Items: " & iTotalItems & "<br><br>" & _
                        "<li>" & strTotalWgt & "<br><br>" & _
                        "<li>" & "Total Pallets: " & iPalletQty & "<br><br>" & _
                        "<li>" & strSingleWgt & "<br><br>" & _
                        "<li>" & strGross & "<br><br>" & _
                        "<li>" & "Collection Location " & sColDest & "<br><br>" & _
                        "<li>" & "Onward Shipping Location " & sEndDest & "<br><br>" & _
                strFE & "</td></tr>"
     Case Else
     
     Do While sFiles <> ""
                strBody = strBody & _
                    "<table style='text-align:left;border:3px solid blue;font-family:arial;border-collapse:collapse;padding:5px'><br>" & _
                    "<font color='blue' font face='Times New Roman' size='3'>Image Name:<B> " & Replace(sFiles, ".jpg", "") & "</B></font>" & _
                     "<P><IMG border=2 hspace=0 alt='' src='file:" & sPath & sFiles & "' align=baseline></P>" & "<br>" & _
                    "</table><br>"
               sFiles = Dir
            Loop
          
     strBody = strBody & "<tr>" & _
                "<td style='background-color:#F5F5F5;border:1px solid black;font-family:arial;border-collapse:collapse;padding:8px'>" & _
                strFS & _
                        "<li>" & "Total Items: " & iTotalItems & "<br><br>" & _
                        "<li>" & strTotalWgt & "<br><br>" & _
                        "<li>" & "Total Pallets: " & iPalletQty & "<br><br>" & _
                        "<li>" & strSingleWgt & "<br><br>" & _
                        "<li>" & strGross & "<br><br>" & _
                        "<li>" & "Collection Location " & sColDest & "<br><br>" & _
                        "<li>" & "Onward Shipping Location " & sEndDest & "<br><br>" & _
                        strFE & "</td></tr>"
'can i add images here inside thi table ?
        End Select




Set rs = Nothing
    
 strBody = strBody & "</table><br>"
 
End Sub

[moke123]

where is it getting the value of sfile or dir?

[Edgar]

If by chance, the issue is that you need to convert your images to base64, which happens with the legacy browser control, then you could try using this function.

Function PathToBase64(imagePath As String) As String
    Dim fileNum As Integer
    Dim imgData() As Byte
    
    fileNum = FreeFile
    Open imagePath For Binary Access Read As fileNum
    ReDim imgData(LOF(fileNum) - 1)
    Get fileNum, , imgData
    Close fileNum
    
    With CreateObject("MSXML2.DOMDocument.6.0").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = imgData
        PathToBase64= "data:image/jpeg;base64," & .Text
    End With

End Function

"<P><IMG border=2 hspace=0 alt='' src='" & PathToBase64(sPath & sFiles) & "' align=baseline></P>" & "<br>" & _

[June7]

Where is this "table" supposed to display?

Yes, an image can be embedded in table. Example:

"<tr><td><img SRC=C:\Users\June\LABDB.png></td></tr>"

In your case, I think as another line in cell:

"<li><img SRC=C:\Users\June\LABDB.png>"

Are these lines showing as bulleted in your output?

[Welshgasman]

Where is this "table" supposed to display?

Yes, an image can be embedded in table. Example:

"<tr><td><img SRC=C:\Users\June\LABDB.png></td></tr>"

In your case, I think as another line in cell:

"<li><img SRC=C:\Users\June\LABDB.png>"

Are these lines showing as bulleted in your output?

@June7,
Is that going to work for the recipient though?, as they will not have the path or file?

I seem to recall I had that issue with images in signatures?

[DMT Dave]

Hi All, sorry i had to come away from this, so i maybe should have explained a little more

take an image of a pallet (goes into sDealer Folder, i tried 2 methods but couldn't get it to work, i liked the way @jojowhite suggested using an append sub then calling it within current module, so i have done quite a lot with this method just can't appear to add images to email using this method, i can easily add images using strEmailImages all in one sub but for some reason not when trying to call from a sub, hope i have explained correct

attempt 1
images having it's own sub then call when the criteria meets me.optAddImages = true

Private Sub AppendImages(ByRef strBody As String)
Dim strEmailImages As String, sFiles As String, sPath As String
 
sPath = "T:\Images\Collections\" & sDealer & "\"
            sFiles = Dir(sPath & "*.jpg")
 
            Do While sFiles <> ""           
            strEmailImages = strEmailImages & _
                    "<table style='text-align:left;border:3px solid blue;font-family:arial;border-collapse:collapse;padding:5px'><br>" & _
                    "<font color='blue' font face='Times New Roman' size='3'>Image Name:<B> " & Replace(sFiles, ".jpg", "") & "</B></font>" & _
                     "<P><IMG border=2 hspace=0 alt='' src='file:" & sPath & sFiles & "' align=baseline></P>" & "<br>" & _
                    "</table><br>"
               sFiles = Dir()
            Loop
         
strBody = strEmailImages
 
 
End Sub

Below all works apart from image been added

‘Call Subs to
‘Print Collection Notes and send images on email
 
Select Case Me.optCollNotes
    Case Is = False
        Exit Sub
    Case Else
 
    Call GreetMail(strBody)'Works
        strReply = strBody
       
    Call IntroMail(strBody)'Works
        strReply = strBody
   
    Call AppendConsignee(strBody)'Works
        strReply = strBody
   
    Call AppendPalletData(strBody)'Works 
        strReply = strBody
   
    Call AppendCollection(strBody)'Works
        strReply = strBody

'COMMENTED OUT NOT ADDING IMAGE INTO IT's OWN TABLE       
   ' Select Case Me.optAddImages
   '     Case Is = True
       
    '    sPath = "T:\Images\Collections\" & sDealer & "\"
    '        sFiles = Dir(sPath & "*.jpg")
 
     '       Do While sFiles <> ""
      '          strBody = strBody & _
                    "<table style='text-align:left;border:3px solid blue;font-family:arial;border-collapse:collapse;padding:5px'><br>" & _
                    "<font color='blue' font face='Times New Roman' size='3'>Image Name:<B> " & Replace(sFiles, ".jpg", "") & "</B></font>" & _
                     "<P><IMG border=2 hspace=0 alt='' src='file:" & sPath & sFiles & "' align=baseline></P>" & "<br>" & _
                    "</table><br>"
       '        sFiles = Dir
       '     Loop
       
        'strReply = strBody & sFiles
   ' End Select
   
    Call SignMail(strBody)
        strReply = strBody
 
‘Populate email
 
Set myItem = myApp.CreateItem(olMailItem)
    Set outAccount = myApp.Session.Accounts.item(1)
    With myItem
    .To = strMailTo
                .CC = strCC
                .Subject = Me.cboDealerIndex7 & " " & sRef & " Collection Ready"
                .HTMLBody = strReply
                .SendUsingAccount = outAccount
                .Display
    End With

because appendimages didnt work
now tried to add images to the end of
appendpalletdata

I have purposely added an image into the sDealer Folder for testing purposes

not read your kindly suggested posts yet, will do very shortly....

ideally would like any images in it'sown table from AppendImages in my calling order

thank yuou all indeed as always

[Welshgasman]

Just add them as attachments?

[DMT Dave]

Hi WGM, yes i could, just looks better in mail body, i have copy of DB not using calling Subs when required, all works, but using the method im trying is much cleaner result, i am going to copy all subs and come back and take an image of the email result.

back soon but thank you and all who suggest options

my Greet mail now not pulling through also, i keep loosing myself trying

will come back a little later, add all here along with email result once i remove sensitive data

[Welshgasman]

Have you tried the code in post #3?

[DMT Dave]

Hi WGM, no, i will take a look at itr though

Thanks again

[DMT Dave]

hi all, tried post #3

Option Compare DatabaseOption Explicit
Function PathToBase64(imagePath As String) As String
    Dim fileNum As Integer
    Dim imgData() As Byte
    
    fileNum = FreeFile
    Open imagePath For Binary Access Read As fileNum
    ReDim imgData(LOF(fileNum) - 1)
    Get fileNum, , imgData
    Close fileNum
    
    With CreateObject("MSXML2.DOMDocument.6.0").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = imgData
        PathToBase64 = "data:image/jpeg;base64," & .text
    End With


End Function

tried adding the html line after AppendPalletData

[DMT Dave]

Just wondering do i have to set a variable, now got GreetMail by changing

Private Sub GreetMail(ByRef strBody As String)Dim strSmiley As String, strFS As String, strFE As String
Dim strToFull As String, strToName As String, TOD As String, strDelTo As String


    strSmiley = "<span style='font-size:16px;'>��</span>"
    strFS = "<font size='3' face='Arial' style=text-align=center; vertical-align=middle>" ' Mail Font
    strFE = "</font>" ' End Font'


strDelTo = Me.cboDealerIndex7
If Not IsNull(strToFull = DLookup("[Contact1]", "tblDealers", "[Name] = '" & strDelTo & "'")) Then
        strToFull = DLookup("[Contact1]", "tblDealers", "[Name] = '" & strDelTo & "'")
        
    If InStr(strToFull, " ") > 0 Then
        strToName = Left(strToFull, InStr(strToFull, " ") - 1)
    Else
        strToName = strToFull
    End If
End If


    Select Case Hour(Now())
    Case Is <= 12
        TOD = strFS & "Good Morning " & strToName & ", Hope you are well " & strFE & strSmiley & "<br>"
    Case Is <= 17
        TOD = strFS & "Good Afternoon " & strToName & ", Hope you are well " & strFE & strSmiley & "<br>"
    Case Else
        TOD = strFS & "Good Evening " & strToName & ", Hope you are well " & strFE & strSmiley & "<br>"
    End Select
    
strBody = TOD


End Sub

Changed
the following when calling

Select Case Me.optCollNotes
    Case Is = False
        Exit Sub
    Case Else


    Call GreetMail(strBody)
        strGreet = strBody
        
    Call IntroMail(strBody)
        strReply = strBody
    
    Call AppendConsignee(strBody)
        strReply = strBody
    
    Call AppendPalletData(strBody)
        strReply = strBody
    
    Call AppendCollection(strBody)
        strReply = strBody
        
    'Call AppendImages(strBody)
    '    strReply = strBody
        
   ' Select Case Me.optAddImages
   '     Case Is = True
        
    '    sPath = "T:\Images\Collections\" & sDealer & "\"
    '        sFiles = Dir(sPath & "*.jpg")


     '       Do While sFiles <> ""
      '          strBody = strBody & _
                    "<table style='text-align:left;border:3px solid blue;font-family:arial;border-collapse:collapse;padding:5px'><br>" & _
                    "<font color='blue' font face='Times New Roman' size='3'>Image Name:<B> " & Replace(sFiles, ".jpg", "") & "</B></font>" & _
                     "<P><IMG border=2 hspace=0 alt='' src='file:" & sPath & sFiles & "' align=baseline></P>" & "<br>" & _
                    "</table><br>"
       '        sFiles = Dir
       '     Loop
        
        'strReply = strBody & sFiles
   ' End Select
    
    Call SignMail(strBody)
        strReply = strBody
    
    strMailBody = strFS & strGreet & "<br>" & _
                        Replace(strReply, "|", "<br>")

Now thinking if I loop images in it's own sub (same as GreetMail) and add variable something like


call (AppenImages(strBody)
strImages = strbody

or am i going down the wrong method here ?

[DMT Dave]

This is the result so far, just need to loop images either within AppendPalletData <br> Now add images
or new sub AppendImages into a new HTML table

outcome



Now trying to add images either end of the HTML table or in a new table and call it after this table

[Welshgasman]

Perhaps you need Public for the function?
Have you tried calling it from the immediate window?
You know, basic debugging?

[jojowhite]

remove the single quote (') from src attribute of your image:

Private Sub AppendImages(ByRef strBody As String)
Dim strEmailImages As String, sFiles As String, sPath As String
 
sPath = "T:\Images\Collections\" & sDealer & "\"
            sFiles = Dir(sPath & "*.jpg")
 
            Do While sFiles <> ""
            strEmailImages = strEmailImages & _
                    "<table style='text-align:left;border:3px solid blue;font-family:arial;border-collapse:collapse;padding:5px'><br>" & _
                    "<font color='blue' font face='Times New Roman' size='3'>Image Name:<B> " & Replace(sFiles, ".jpg", "") & "</B></font>" & _
                     "<P><IMG border=2 hspace=0 alt='' width=100% src=" & sPath & sFiles & " align=baseline></P>" & "<br>" & _
                    "</table><br>"
               sFiles = Dir()
            Loop
         
strBody = strEmailImages
 
 
End Sub