Hallöchen,
ich habe eine Frage. Ich will über ein Outlook Makro unter anderen Bilder direkt ausdrucken. Nun wird bei einem Bild erstmal die Windows Fotoanzeige geöffnet. Nun dachte ich, man könnte doch bestimmt auch mit der Shell Option direkt das "Senden an" ausführen? Gibt es diese Möglichkeit?
Spoiler anzeigen
Spoiler anzeigen
Spoiler anzeigen
ich habe eine Frage. Ich will über ein Outlook Makro unter anderen Bilder direkt ausdrucken. Nun wird bei einem Bild erstmal die Windows Fotoanzeige geöffnet. Nun dachte ich, man könnte doch bestimmt auch mit der Shell Option direkt das "Senden an" ausführen? Gibt es diese Möglichkeit?
Visual Basic-Quellcode
- #If VBA7 Then
- Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
- ByVal hwnd As LongPtr, _
- ByVal lpOperation As String, _
- ByVal lpFile As String, _
- ByVal lpParameters As String, _
- ByVal lpDirectory As String, _
- ByVal nShowCmd As LongPtr) As LongPtr
- #Else
- Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
- ByVal hwnd As Long, _
- ByVal lpOperation As String, _
- ByVal lpFile As String, _
- ByVal lpParameters As String, _
- ByVal lpDirectory As String, _
- ByVal nShowCmd As Long) As Long
- #End If
Visual Basic-Quellcode
- Dim strUserName As String
- Dim strFilePath As String
- Public Sub PrintSelectedAttachments()
- Dim otlExplorer As Outlook.Explorer
- Dim otlSelection As Outlook.Selection
- Dim obj As Object
- Set otlExplorer = Application.ActiveExplorer
- Set otlSelection = otlExplorer.Selection
- strUserName = Environ("UserName")
- strFilePath = "C:\Users\" & strUserName & "\Desktop\Anlagen"
- For Each obj In otlSelection
- If TypeOf obj Is Outlook.MailItem Then PrintAttachments obj
- Next
- Set otlSelection = Nothing
- Set otlExplorer = Nothing
- RmDir (strFilePath)
- End Sub
Visual Basic-Quellcode
- Private Sub PrintAttachments(otlMail As Outlook.MailItem)
- Dim otlAttCounter As Outlook.Attachments
- Dim otlAtt As Outlook.Attachment
- Dim strFile As String
- Dim strFileType As String
- Dim strPrinterName As String
- strUserName = Environ("UserName")
- strFilePath = "C:\Users\" & strUserName & "\Desktop\Anlagen"
- Call GetDefaultPrinterName(strPrinterName)
- On Error Resume Next
- If Dir(strFilePath, vbDirectory) = "" Then MkDir (strFilePath)
- Set otlAttCounter = otlMail.Attachments
- If otlAttCounter.Count Then
- For Each otlAtt In otlAttCounter
- strFileType = LCase$(Right$(otlAtt.FileName, 4))
- Select Case strFileType
- Case ".xls", ".xlsx", ".doc", ".docx", ".pdf"
- strFile = ATTACHMENT_DIRECTORY & otlAtt.FileName
- otlAtt.SaveAsFile (strFile)
- ShellExecute 0, "print", strFile, vbNullString, vbNullString, 0
- Case ".tif", ".jpg", ".jpeg", ".png"
- strFile = ATTACHMENT_DIRECTORY & otlAtt.FileName
- otlAtt.SaveAsFile (strFile)
- ShellExecute 0, "printto", strFile, strPrinterName, vbNullString, 0
- End Select
- Next
- End If
- Set otlAttCounter = Nothing
- End Sub
Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „Sam85“ ()