Image aus Zwischenablage mit Outlook-VBA als Datei speichern

  • Outlook

Es gibt 15 Antworten in diesem Thema. Der letzte Beitrag () ist von ftzdOp.

    Image aus Zwischenablage mit Outlook-VBA als Datei speichern

    Liebe Community,
    ich bin seit ein paar Tagen in den einschlägigen Foren auf der Suche, habe aber noch keine Lösung gefunden und hoffe jmd. kann mir hier weiterhelfen.

    Zu meinem Fall: ich erstelle in Outlook einen klassischen UserForm (keines dieser E-Mail Formulare), welches zu Schichtende ausgefüllt werden soll. Bei Fertigstellung soll folgendes Prozedere durchgeführt werden:

    1. Screenshot erstellen und in Zwischenablage speichern
    2. Screenshot in MailItem kopieren (am liebsten in den Body, zur Not als Attachment)
    3. E-Mail an den Kunden versenden

    Für Schritt 1 und 3 habe ich bereits Code. Jedoch kriege ich keinen Zugriff auf die Zwischenablage. Es gibt im Outlook-VBA ein sog. "dataobject". Allerdings ermöglicht dieses nur Zugriff auf Text in der Zwischenablage, jedoch nicht auf images (was ein screenshot ja nunmal ist)

    Ich habe eine ähnliche Lösung für Excel gefunden (herber.de/forum/archiv/568to57…kt_in_File_speichern.html). Jedoch existieren die entsprechende Objekte in Outlook nicht. Ich bräuchte quasi etwas analoges. Das Sahnehäubchen wäre wie gesagt ein direktes Kopieren in den Body, aber eine Speicherung als File wäre fürs erste vollkommen ausreichend.

    Hoffe ich konnte mich verständlich ausdrücken. Danke schonmal vorab für eure Hilfe!
    Bernd

    P.S.: klar könnte ich auch die Textfelder des UserForms als Text ins MailItem schreiben. Allerdings sind dort bereits einige Funktionen zur Visualisierung enthalten, die ich gerne dem Kunden zur Vefügung stellen möchte.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Berhauer“ ()

    Ich habe mal etwas gegoogelt. Anscheinend ist es sehr kompliziert, so etwas in VBA zu realisieren, weil es von Haus aus keine Möglichkeit gibt (komischerweise aber in VB6).

    Gefunden habe ich das hier, was evtl. einen Ansatz geben könnte:
    wordmvp.com/FAQs/MacrosVBA/ManipulateClipboard.htm
    (Oder kanntest du das schon? Vielleicht kann das DataObject auch ein Image sein?)

    Und das hier, was vielleicht die Lösung ist, aber recht komplex:
    social.msdn.microsoft.com/Foru…rosoft-word?forum=worddev
    Besucht auch mein anderes Forum:
    Das Amateurfilm-Forum
    Hallo!

    Das Bildschirmfoto als Bild auf Festplatte speichern und dann eine Email erstellen wäre einfacher.

    In ein allgemeines Modul:

    Visual Basic-Quellcode

    1. Option Private Module
    2. Option Explicit
    3. Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    4. Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (ByRef PicDesc As PicBmp, _
    5. ByRef RefIID As GUID, _
    6. ByVal fPictureOwnsHandle As Long, _
    7. ByRef IPic As IPicture) As Long
    8. Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
    9. Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, _
    10. ByVal nHeight As Long) As Long
    11. Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
    12. Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long
    13. Private Declare Function GetSystemPaletteEntries Lib "gdi32.dll" (ByVal hdc As Long, ByVal wStartIndex As Long, _
    14. ByVal wNumEntries As Long, ByRef lpPaletteEntries As PALETTEENTRY) As Long
    15. Private Declare Function CreatePalette Lib "gdi32.dll" (ByRef lpLogPalette As LOGPALETTE) As Long
    16. Private Declare Function SelectPalette Lib "gdi32.dll" (ByVal hdc As Long, ByVal hPalette As Long, _
    17. ByVal bForceBackground As Long) As Long
    18. Private Declare Function RealizePalette Lib "gdi32.dll" (ByVal hdc As Long) As Long
    19. Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal x As Long, _
    20. ByVal y As Long, ByVal nWidth As Long, _
    21. ByVal nHeight As Long, ByVal hSrcDC As Long, _
    22. ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    23. Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
    24. Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
    25. Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, ByRef lpRect As RECT) As Long
    26. Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
    27. Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
    28. Private Const SM_CXSCREEN = 0&
    29. Private Const SM_CYSCREEN = 1&
    30. Private Const RC_PALETTE As Long = &H100
    31. Private Const SIZEPALETTE As Long = 104
    32. Private Const RASTERCAPS As Long = 38
    33. Private Type RECT
    34. Left As Long
    35. Top As Long
    36. Right As Long
    37. Bottom As Long
    38. End Type
    39. Private Type PALETTEENTRY
    40. peRed As Byte
    41. peGreen As Byte
    42. peBlue As Byte
    43. peFlags As Byte
    44. End Type
    45. Private Type LOGPALETTE
    46. palVersion As Integer
    47. palNumEntries As Integer
    48. palPalEntry(255) As PALETTEENTRY
    49. End Type
    50. Private Type GUID
    51. Data1 As Long
    52. Data2 As Integer
    53. Data3 As Integer
    54. Data4(7) As Byte
    55. End Type
    56. Private Type PicBmp
    57. Size As Long
    58. Type As Long
    59. hBmp As Long
    60. hPal As Long
    61. Reserved As Long
    62. End Type
    63. Public Sub prcSave_Picture_Screen(Optional strPicturePath As String = "C:\Test.bmp") 'ganzer bildschirm
    64. stdole.SavePicture hDCToPicture(GetDC(0&), 0&, 0&, _
    65. GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN)), strPicturePath 'anpassen !!!
    66. End Sub
    67. Public Sub prcSave_Picture_Active_Window(Optional strPicturePath As String = "C:\test.bmp", Optional bolSleep As Boolean = False) 'aktives Fenster
    68. Dim hWnd As Long
    69. Dim udtRect As RECT
    70. If bolSleep Then Sleep 3000 '3 sekunden pause um ein anderes Fenster zu aktivieren
    71. hWnd = GetForegroundWindow
    72. GetWindowRect hWnd, udtRect
    73. stdole.SavePicture hDCToPicture(GetDC(0&), udtRect.Left, udtRect.Top, _
    74. udtRect.Right - udtRect.Left, udtRect.Bottom - udtRect.Top), strPicturePath 'anpassen !!!
    75. End Sub
    76. Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Object
    77. Dim Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID
    78. With IID_IDispatch
    79. .Data1 = &H20400
    80. .Data4(0) = &HC0
    81. .Data4(7) = &H46
    82. End With
    83. With Pic
    84. .Size = Len(Pic)
    85. .Type = 1
    86. .hBmp = hBmp
    87. .hPal = hPal
    88. End With
    89. Call OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
    90. Set CreateBitmapPicture = IPic
    91. End Function
    92. Public Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, _
    93. ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Object
    94. Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long
    95. Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long
    96. Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE
    97. hDCMemory = CreateCompatibleDC(hDCSrc)
    98. hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
    99. hBmpPrev = SelectObject(hDCMemory, hBmp)
    100. RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
    101. HasPaletteScrn = RasterCapsScrn And RC_PALETTE
    102. PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
    103. If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    104. LogPal.palVersion = &H300
    105. LogPal.palNumEntries = 256
    106. Call GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
    107. hPal = CreatePalette(LogPal)
    108. hPalPrev = SelectPalette(hDCMemory, hPal, 0)
    109. Call RealizePalette(hDCMemory)
    110. End If
    111. Call BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, 13369376)
    112. hBmp = SelectObject(hDCMemory, hBmpPrev)
    113. If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    114. hPal = SelectPalette(hDCMemory, hPalPrev, 0)
    115. End If
    116. Call DeleteDC(hDCMemory)
    117. Set hDCToPicture = CreateBitmapPicture(hBmp, hPal)
    118. End Function


    In der Userform eine zusätzliche Schaltfläche erstellen mit folgendem Code, oder den Code für die "Beenden-Schaltfläche" entsprechend ergänzen.

    Visual Basic-Quellcode

    1. Private Sub CommandButton1_Click()
    2. Dim strPicPath As String
    3. ' Pfad und Name für Bild
    4. strPicPath = Environ("USERPROFILE") & "\Desktop\UF1.jpg"
    5. 'Bild von Userform erstellen und auf Festplatte speichern
    6. Call prcSave_Picture_Active_Window(strPicPath)
    7. 'Userform schließen (Email kann sonst nicht generiert werden)
    8. Unload Me
    9. 'Email mit Bild erstellen
    10. With Application.CreateItem(0)
    11. .To = "beispiel@example.org"
    12. .Subject = "Test"
    13. .HTMLBody = "Hallo,<br><br>anbei ein Beispielbild.<br><br>" & _
    14. "<img src='" & strPicPath & "' alt='Avatar 2' title='Avatar 2'>" & _
    15. "<br><br>"
    16. .Display
    17. End With
    18. 'Bild wieder von Festplatte löschen
    19. Kill strPicPath
    20. End Sub


    Gruß, René

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „mumpel“ () aus folgendem Grund: Kleine Codeanpassung

    Guten Morgen nochmal von meiner Seite,

    ich habe eure beiden Ansaetze einmal ausprobiert:

    @Marcus: deinen obrigen Ansatz kannte ich bereits. Trotzdem danke nochmal. Das Problem ist dieser "DataObject" Type - er kann lediglich Strings verarbeiten. Finde die Bezeichnung daher sehr irrefuehrend...
    @René: Chapeau, musste lediglich ein wenig mit dem Pfad herumspielen und das ganze funktioniert einwandfrei und scheint sehr robust zu sein :). Vielen, vielen Dank!

    Berhauer schrieb:


    (...) Das Problem ist dieser "DataObject" Type - er kann lediglich Strings verarbeiten (...)

    Vielleicht findet sich ja doch eine einfache Lösung.

    Berhauer schrieb:


    (...) Finde die Bezeichnung daher sehr irrefuehrend (...)

    "Data" bedeutet doch Daten? Und Daten sind immer Text, nicht Bild. ;)


    Berhauer schrieb:


    (...) das ganze funktioniert einwandfrei und scheint sehr robust zu sein (...)

    Wenn man weiss wo es steht ist es leicht. ;) Der API-Code stammt von Max Kaffl (alias Nepumuk).
    Hallo mumpel (und alle anderen Interessierten),

    ich muss mich nochmal bzgl. meines Anliegens aus der letzten Woche melden. Bzgl des unteren Quellcodes von Mumpel:

    das Bild wird zwischengespeichert, allerdings wird in dem HTML-body lediglich eine Verknuepfung zu der Grafik auf der Festplatte erstellt. Ich hatte den Kill-Befehl letzte Woche ignoriert, sonst waere mir das wohl sofort aufgefallen. Jetzt habe ich die E-Mail allerdings nicht an meine eigenen Outlook-Adresse geschickt (also Absender=Empfaenger, und somit fuer beide Zugriff auf den Pfad) sondern an eine dritte Adresse. Die Groesse der mail (4kb) spricht ebenfalls dafuer, dass lediglich ein Pfad geschickt wurde (auf den der dritte Empfaenger dann natuerlich keinen Zugriff hat).
    Es waere klasse, wenn jmd. hierfuer noch eine Loesung findet (fuer den body, bitte nicht als Attachment)

    Danke und viele Gruesse
    Bernd

    ---
    edit, ich habe eine Loesung fuer das Problem gefunden:
    es muss zuerst ein attachment erstellt werden. Der "interne Hyperlink" greift dann nciht mehr auf den Festplatten-Pfad sondern direkt auf das Attachment zu:

    Visual Basic-Quellcode

    1. Private Sub CommandButton1_Click()
    2. Dim strPicPath As String
    3. ' Pfad und Name für Bild
    4. strPicPath = Environ("USERPROFILE") & "\Desktop\UF1.jpg"
    5. 'Bild von Userform erstellen und auf Festplatte speichern
    6. Call prcSave_Picture_Active_Window(strPicPath)
    7. 'Userform schließen (Email kann sonst nicht generiert werden)
    8. Unload Me
    9. 'Email mit Bild erstellen
    10. With Application.CreateItem(0)
    11. .To = "beispiel@example.org"
    12. .Subject = "Test"
    13. .Attachments.add "strPicPath", olByValue, 0 'somit bleibt das Image im Attachment unsichtbar
    14. .HTMLBody = "Hallo,<br><br>anbei ein Beispielbild.<br><br>" & _
    15. "<img src='cid:UF1.jpg'" & "<br><br>"
    16. .Display
    17. End With
    18. 'Bild wieder von Festplatte löschen
    19. Kill strPicPath
    20. End Sub


    Meine Quelle ist: excel-macro.tutorialhorizon.co…m-ms-outlook-using-excel/

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „Berhauer“ ()

    Also so richtig verstehe ich das Problem nicht. (Aber vielleicht liege ich ja komplett falsch)

    Also, ich hab das mal in Word umgesetzt:

    Ein Verweis auf die MS Forms ist dafür nötig. (Nicht nur wg. der cmd-Buttons, sondern auch wegen des DataObject )
    Der Code läuft in ThisDocument. So wie ich das jetzt kurz umgesetzt habe, muss man erst einmal auf den cmd2 drücken, damit das Objekt da ist. Dann ein Bild, das in der Zwischenablage ist mit cmd1 Klick einfügen. Und falls Outlook das DataObject nicht unterstützen sollte, dann eben für diese Aktion kurz Word als eMail-Editor einsetzen und danach wieder zurück.

    Quellcode

    1. Private MyClip As DataObject
    2. Private Sub CommandButton1_Click()
    3. MyClip.GetFromClipboard
    4. Selection.Paste
    5. Set MyClip = Nothing
    6. End Sub
    7. Private Sub CommandButton2_Click()
    8. Set MyClip = New DataObject
    9. End Sub


    edit: EditorType = olEditorWord
    IsWordMail = True; dann sollte es so gehen
    Hilfreiche Antworten als solche zu Kennzeichnen wäre klasse 8-)

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „ftzdOp“ ()

    So wäre das Thema wohl erledigt:

    Visual Basic-Quellcode

    1. 'Referenz auf MS Forms 2.0
    2. Private MyClip As DataObject
    3. Public Sub MyPaste()
    4. 'Referenz auf Microsoft Word Object Library
    5. Dim Selection_lcl As Word.Selection
    6. On Error Resume Next
    7. ' Auf Objektebene deklariert kann das Ding - glaube ich - sogar mehrere (24) Einträge verwalten.
    8. If MyClip Is Nothing Then Set MyClip = New DataObject
    9. Set Selection_lcl = Me.ActiveInspector.CurrentItem.GetInspector.WordEditor.Application.Selection
    10. Selection_lcl.Paste
    11. Set Selection_lcl = Nothing
    12. Set MyClip = Nothing
    13. End Sub

    Ich verstehe nicht, dass alle Welt da immer mit den API-Calls arbeitet. Das DataObject gibt es glaube ich schon seit Office 2007 und es kann mir allen Formaten, die Word unterstützt, umgehen.
    Hilfreiche Antworten als solche zu Kennzeichnen wäre klasse 8-)

    Dieser Beitrag wurde bereits 10 mal editiert, zuletzt von „ftzdOp“ ()

    Das mit dem Word-Editor ist mir vor ein paar Tagen auch schon eingefallen (in einem gleichgeartetem Thema in einem anderen Forum). Das Einfache fällt einem immer erst zum Schluß ein. Mit dem folgenden Code kann man das Bild an einer vordefinierten Stelle einfügen.

    Visual Basic-Quellcode

    1. Public Sub Email_Erstellen_Formatiert()
    2. Dim olApp As Object
    3. Dim wdApp As Object
    4. Dim wdDoc As Object
    5. Dim wdRange As Object
    6. Dim olOldbody As String
    7. Dim olNewBody As String
    8. ' Emailtext erstellen
    9. olNewBody = "Hallo!" & "<br><br>" ' Grußzeile
    10. olNewBody = olNewBody & "Anbei gewünschte Informationen." & "<br><br>" ' Zeile 1
    11. olNewBody = olNewBody & "Ihre Auftragsnummer lautet: " & Range("A1") & "<br><br>" 'Zeile 2
    12. olNewBody = olNewBody & " " & "<br><br>"
    13. olNewBody = olNewBody & " " & "<br><br>"
    14. olNewBody = olNewBody & "Mit freundlichen Grüßen," & "<br>" ' Schlußgruß
    15. olNewBody = olNewBody & "Max Mustermann" ' Name/Unterschrift
    16. ' Outlook-Objekt erstellen
    17. Set olApp = CreateObject("Outlook.Application")
    18. ' Email erstellen
    19. With olApp.CreateItem(0)
    20. .GetInspector.Display
    21. olOldbody = .htmlBody
    22. .Subject = "Test"
    23. .htmlBody = olNewBody
    24. ' Word-Editor-Objekt erstellen (zum Formatieren erforderlich)
    25. Set wdApp = .GetInspector
    26. Set wdDoc = wdApp.WordEditor
    27. ' Bild einfügen
    28. Set wdRange = wdDoc.Range(72, 72)
    29. wdRange.Paste
    30. ' Emailtext um Signatur ergänzen
    31. .htmlBody = .htmlBody & "<br><br>" & olOldbody
    32. End With
    33. ' Objekte freigeben
    34. Set wdRange = Nothing
    35. Set wdDoc = Nothing
    36. Set wdApp = Nothing
    37. Set olApp = Nothing
    38. End Sub


    Aber ganz ohne API kommt man nicht aus wenn man das Bildschirmfoto automatisiert erstellen möchte, da die SendKeys-Methode extrem fehlerhaft arbeitet (bei mir unter Windows 10 funktioniert SendKeys (%{PRTSC}) nicht)
    Hm, glaub ich nicht, dass nicht ohne API geht; klar, Sendkeys güldet nicht, ist Quark ... Mal sehen.

    Edit:
    Hm, ich dachte man kommt an "Einfügen/Screenshot" ran. Aber Word arbeitet da so, dass alle offenen Windows-Fenster in einer Preview angezeigt werden. Wählt man eins aus, dann wird eine TMP Datei (jpg) erstellt und die packt Word dann selber über InlineShapes.AddPicture ins Dokument. Es gibt aber keinen Fullscreen. Diesen Dialog könnte man eventuell aurufen, aber dazu habe ich jetzt keine Motivation X/

    BTW: Wo ich gerade Deine Signatur sehe: Guck mal bitte hier: BuiltIn RibbonControls in Office instanzieren
    Hilfreiche Antworten als solche zu Kennzeichnen wäre klasse 8-)

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „ftzdOp“ ()

    ftzdOp schrieb:


    (...) Diesen Dialog könnte man eventuell aurufen (...)

    Das taugt m.E. nicht für automatisierte Bildschirmfotos. Zudem gibt es in Outlook die Anweisung Application.CommandBars.ExecuteMso nicht.
    Nö, nicht Auto , aber etwas Komfort. ;)
    Na, den Dialog müsste man über die WordApp starten, denke ich mir mal so.


    mumpel schrieb:

    et (bei mir unter Windows 10 funktioniert SendKeys (%{PRTSC}) nicht)


    Wenn es mal nötig sein sollte und Du eine deutsches Keyboardlayout hast versuche mal {druck} aber eben auch klein geschrieben.
    Hilfreiche Antworten als solche zu Kennzeichnen wäre klasse 8-)
    Dann solltest Du auf jeden Fall die Taste austauschen oder zur Reparatur bringen lassen, vllt im Rahmen der jährlichen Inspektion oder beim Nachjustieren der Tastenrückholfedern. !!
    Hilfreiche Antworten als solche zu Kennzeichnen wäre klasse 8-)