1
\$\begingroup\$

I cannot use add ins here so I set out to create an excel application that could get the job done. I suppose that I could easily transport this into outlook?

Basically I want to click one of the icons and have the img inside that icons insert into the email that I am working on.

Question re unit testing: Here it seems like I have to unit test by hand in a sense. I suppose I could write code that simulates the object application environments, ie opens outlook application and then creates multiple popped out emails, no emails, a mix of popped out and inline etc? Then I pass this to each individual function and see that it works?

This Workbook:

Private Sub Workbook_Open()
    Me.Windows(1).WindowState = xlMinimized
    EmjoiControlPanel.Show vbModal
End Sub

EmojiControlPanel:

Option Explicit

Sub Image1_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image1
End Sub

Sub Image2_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image2
End Sub

Sub Image3_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image3
End Sub

Sub Image4_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image4
End Sub

Sub Image5_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image5
End Sub

Sub Image6_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image6
End Sub

Sub Image7_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image7
End Sub

Sub Image8_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image8
End Sub

Sub Image9_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image9
End Sub

Sub Image10_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image10
End Sub

Sub Image11_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image11
End Sub

Sub Image12_Click()
    TransferImg.EmojiEmailTransfer EmjoiControlPanel.Image12
End Sub

TransferIMG:

Option Explicit

Public Sub EmojiEmailTransfer(ByRef picControl As Image)
On Error GoTo Delete
Dim olApp                                       As Outlook.Application
Dim pictureFilePath                             As String

    Set olApp = GetObject(, "Outlook.Application")

    pictureFilePath = "Z:\tempPic"
    SavePicture picControl.picture, pictureFilePath

    If TypeName(olApp.ActiveWindow) = "Inspector" Then
        PoppedOutEmailLoadPicture olApp, pictureFilePath
    ElseIf TypeName(olApp.ActiveWindow) = "Explorer" Then
        NotPoppedOutEmailLoadPicture olApp, pictureFilePath
    End If

Delete:
    DeleteFile pictureFilePath
End Sub

Private Sub PoppedOutEmailLoadPicture(ByRef olApp As Outlook.Application, ByRef pictureFilePath As String)
On Error GoTo CouldNotLoad
    Dim objDoc                                  As Word.Document
    Dim objSelect                               As Word.Selection

    Set objDoc = olApp.ActiveInspector.WordEditor
    Set objSelect = objDoc.Windows(1).Selection

    objSelect.InlineShapes.AddPicture pictureFilePath
    Exit Sub
CouldNotLoad:
End Sub

Private Sub NotPoppedOutEmailLoadPicture(ByRef olApp As Outlook.Application, ByRef pictureFilePath As String)
On Error GoTo CouldNotLoad
    Dim objDoc                                  As Word.Document
    Dim objSelect                               As Word.Selection

    Set objDoc = olApp.ActiveExplorer.ActiveInlineResponseWordEditor
    Set objSelect = objDoc.Windows(1).Selection

    objSelect.InlineShapes.AddPicture pictureFilePath
    Exit Sub
CouldNotLoad:
End Sub

Private Sub DeleteFile(ByRef pictureFilePath As String)
    Dim fso As Object
        Set fso = CreateObject("scripting.filesystemobject")
    If fso.fileexists(pictureFilePath) Then fso.DeleteFile ("" & pictureFilePath & "")
End Sub

RunApp (Assigned to a button in worksheet):

Sub RunApp()
    ActiveWorkbook.Windows(1).WindowState = xlMinimized
    EmjoiControlPanel.Show vbModal
End Sub

enter image description here

\$\endgroup\$
3
  • \$\begingroup\$ Without having read your question yet - rubberduck can help with unit testing VBA. \$\endgroup\$ – Raystafarian Aug 30 '18 at 0:01
  • \$\begingroup\$ basically rubberduck is an add in to VBA's IDE? \$\endgroup\$ – learnAsWeGo Aug 31 '18 at 15:01
  • \$\begingroup\$ Indeed it is just that \$\endgroup\$ – Raystafarian Aug 31 '18 at 19:39

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.