Pictures in email attachment not working

smj43

New Member
Joined
Jan 13, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hi all, first post here but could really do with some help!

I've got a code which I'm using as part of a form which will allow the user to click a command button to insert pictures into another sheet. I've then got another command button which will send the completed form together with the 2nd worksheet containing the pictures. Everything works great however there are 2 issues:

1. When the pictures are inserted into the 'Pictures' worksheet, they stack on top of each other. Is there anyway to get the pictures to be inserted separately (i.e. one below the other)?
2. When opening the email attachment, the pictures do not show. Instead I get 'The linked picture cannot be displayed' error message. Why is this?

Here is the code I'm using...

VBA Code:
Private Sub CommandButton1_Click()

Dim oApp As Object
   Dim oMail As Object
   Dim LWorkbook As Workbook
   Dim LFileName As String


   'Turn off screen updating
   Application.ScreenUpdating = False


   'Copy the active worksheet and save to a temporary workbook
   Sheets(Array("Form", "Pictures")).Copy
   Set LWorkbook = ActiveWorkbook


   'Create a temporary file in your current directory that uses the name
   ' of the sheet as the filename
   LFileName = Range("C5") & " New Store Request.xlsx"
   On Error Resume Next
   'Delete the file if it already exists
   Kill LFileName
   On Error GoTo 0
   'Save temporary file
   Application.DisplayAlerts = False
   LWorkbook.SaveAs Filename:=LFileName


   'Create an Outlook object and new mail message
   Set oApp = CreateObject("Outlook.Application")
   Set oMail = oApp.CreateItem(0)


   'Set mail attributes (uncomment lines to enter attributes)
   ' In this example, only the attachment is being added to the mail message
   With oMail
      .To = "email@email.com"
      .Subject = Range("C5") & " New Store Request Form"
      .body = "Hello," & vbCrLf & vbCrLf & _
      "Please find attached completed New Store Request Form" & vbCrLf & vbCrLf & _
      "Kind Regards"
      .Attachments.Add LWorkbook.FullName
      '.Display  'Comment out this line and uncomment the next line when ready to auto-send email
      .Send    'Uncomment this line and comment out the line above when ready to auto-send email
   End With


   'Delete the temporary file and close temporary Workbook
   LWorkbook.ChangeFileAccess Mode:=xlReadOnly
   Kill LWorkbook.FullName
   LWorkbook.Close SaveChanges:=False


   'Turn back on screen updating
   Application.ScreenUpdating = True
   Set oMail = Nothing
   Set oApp = Nothing
   
   MsgBox "Your request has been succesfully submitted"

End Sub

Private Sub CommandButton2_Click()
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngDest As Range
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set rngDest = Worksheets("Pictures").Range("A1:M27")
    Set objPic = Worksheets("Pictures").Pictures.Insert(strFileName)
    With objPic
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = rngDest.Left
        .Top = rngDest.Top
        .Width = rngDest.Width
        .Height = rngDest.Height
    End With
    MsgBox "Your picture has been added"
End Sub

Hopefully this makes sense. I'm not at all clued up on this so if anyone can help in the most dumbed down terms, it would be much appreciated!
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

smj43

New Member
Joined
Jan 13, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
I was able to 'fix' point number 2 by changing the code from .Pictures.Insert to .Shapes.AddPictures. The code works (as in does what it should) and can now see pictures in the email attachment however the code is bugging 'Run Time Error 13 Type Mismatch'. What have I done wrong?

VBA Code:
Private Sub CommandButton2_Click()
    Dim strFileName As String
    Dim objPic As Picture
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set objPic = Worksheets("Pictures").Shapes.AddPicture(Filename:=(strFileName), linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=0, Top:=0, Width:=300, Height:=300)
    MsgBox "Your picture has been added"
End Sub
 

smj43

New Member
Joined
Jan 13, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Don't worry, found the error. It is working fine now :)

Just need some help with my 1st point please....

1. When the pictures are inserted into the 'Pictures' worksheet, they stack on top of each other. Is there anyway to get the pictures to be inserted separately (i.e. one below the other)?

Here is current code...

VBA Code:
Private Sub CommandButton1_Click()

Dim oApp As Object
   Dim oMail As Object
   Dim LWorkbook As Workbook
   Dim LFileName As String


   'Turn off screen updating
   Application.ScreenUpdating = False


   'Copy the active worksheet and save to a temporary workbook
   Sheets(Array("Form", "Pictures")).Copy
   Set LWorkbook = ActiveWorkbook


   'Create a temporary file in your current directory that uses the name
   ' of the sheet as the filename
   LFileName = Range("C5") & " New Store Request.xlsx"
   On Error Resume Next
   'Delete the file if it already exists
   Kill LFileName
   On Error GoTo 0
   'Save temporary file
   Application.DisplayAlerts = False
   LWorkbook.SaveAs Filename:=LFileName


   'Create an Outlook object and new mail message
   Set oApp = CreateObject("Outlook.Application")
   Set oMail = oApp.CreateItem(0)


   'Set mail attributes (uncomment lines to enter attributes)
   ' In this example, only the attachment is being added to the mail message
   With oMail
      .To = "email@email.com"
      .Subject = Range("C5") & " New Store Request Form"
      .body = "Hello," & vbCrLf & vbCrLf & _
      "Please find attached completed New Store Request Form" & vbCrLf & vbCrLf & _
      "Kind Regards"
      .Attachments.Add LWorkbook.FullName
      '.Display  'Comment out this line and uncomment the next line when ready to auto-send email
      .Send    'Uncomment this line and comment out the line above when ready to auto-send email
   End With


   'Delete the temporary file and close temporary Workbook
   LWorkbook.ChangeFileAccess Mode:=xlReadOnly
   Kill LWorkbook.FullName
   LWorkbook.Close SaveChanges:=False


   'Turn back on screen updating
   Application.ScreenUpdating = True
   Set oMail = Nothing
   Set oApp = Nothing
   
   MsgBox "Your request has been succesfully submitted"

End Sub

Private Sub CommandButton2_Click()
    Dim strFileName As String
    Dim objPic As Object
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set objPic = Worksheets("Pictures").Shapes.AddPicture(Filename:=(strFileName), linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=0, Top:=0, Width:=300, Height:=300)
    MsgBox "Your picture has been added"
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,504
Messages
5,625,183
Members
416,077
Latest member
SJSB

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top