Come faccio a rendere Outlook 2010 gli allegati di stampa automaticamente?


2

Sto cercando di ottenere Outlook 2010 per stampare gli allegati automaticamente all'arrivo.

ho trovato Questo su internet. Il codice VBA è

Sub LSPrint(Item As Outlook.MailItem)  
    On Error GoTo OError

    'detect Temp
    Dim oFS As FileSystemObject
    Dim sTempFolder As String
    Set oFS = New FileSystemObject
    'Temporary Folder Path
    sTempFolder = oFS.GetSpecialFolder(TemporaryFolder)

    'creates a special temp folder
    cTmpFld = sTempFolder & "\OETMP" & Format(Now, "yyyymmddhhmmss")
    MkDir (cTmpFld)

    'save & print
    Dim oAtt As Attachment
    For Each oAtt In Item.Attachments
      FileName = oAtt.FileName
      FullFile = cTmpFld & "\" & FileName

      'save attachment
      oAtt.SaveAsFile (FullFile)

      'prints attachment
      Set objShell = CreateObject("Shell.Application")
      Set objFolder = objShell.NameSpace(0)
      Set objFolderItem = objFolder.ParseName(FullFile)
      objFolderItem.InvokeVerbEx ("print")

    Next oAtt

    'Cleanup
    If Not oFS Is Nothing Then Set oFS = Nothing
    If Not objFolder Is Nothing Then Set objFolder = Nothing
    If Not objFolderItem Is Nothing Then Set objFolderItem = Nothing
    If Not objShell Is Nothing Then Set objShell = Nothing

  OError:
    If Err <> 0 Then
      MsgBox Err.Number & " - " & Err.Description
      Err.Clear
    End If
    Exit Sub

  End Sub

Ho permesso l'esecuzione di macro. Ho incollato il codice in ThisOutlookSession nell'editor VBA e aggiunto un riferimento a Microsoft Scripting Runtime. Ho creato una regola per verificare se il nuovo messaggio proviene da me e in tal caso eseguire lo script. Ho inviato un messaggio con un allegato .doc a me stesso e ho ricevuto il messaggio di errore "424 - Oggetto richiesto" al momento del ricevimento.

Non ho una stampante a casa (ho bisogno del codice per un posto diverso), quindi ho impostato Microsoft XPS Writer come stampante predefinita per vedere se funziona. È questa la ragione dell'errore? In caso contrario, che cos'è e come posso risolverlo?

E, soprattutto, come faccio a portare a termine il lavoro? Ho bisogno di usare uno script VBA (non un componente aggiuntivo) e sono nuovo di VBA.

Sto usando Windows XP ora, ma ho bisogno che la cosa funzioni su Windows 7.


Se apri l'editor VBA, puoi impostare un punto di interruzione all'inizio della tua macro. Quindi, ripeti il ​​test con l'invio di una mail. Apparirà l'editor e sarà possibile eseguire la macro linea per linea con F8. In questo modo, otteniamo maggiori dettagli, quale linea provoca l'errore.
nixda

Hai provato questo codice VBA pure? O forse questo soluzione basata su regole ?
nixda

@nixda Per quanto riguarda la seconda domanda, sì un paio di volte, soprattutto in questa versione e niente sembrava accadere. Ma non ho aggiunto alcuna regola qui - ho appena eseguito la sceneggiatura come Diane Poremsky consiglia nel suo post.
Michał Masny

@nixda Il messaggio di errore appare dopo aver premuto F8 con questa riga evidenziata: "MsgBox Err.Number & amp;" - "& amp; Err.Description".
Michał Masny

@nixda La soluzione nel secondo link riguarda un problema diverso. Le regole da sole non sono sufficienti per stampare allegati automaticamente. Permettono solo di stampare messaggi.
Michał Masny

Risposte:


1

Incolla il seguente codice in ThisOutlookSession.

Modificare il codice secondo necessità, quindi fare clic su Application_Startup() macro e premere il pulsante Esegui (F8). Ciò avvia la macro senza la necessità di riavviare Outlook.

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

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olNameSpace As Outlook.NameSpace
    Dim Folder As Outlook.MAPIFolder

    Set olNameSpace = Application.GetNamespace("MAPI")
    Set Folder = olNameSpace.GetDefaultFolder(olFolderInbox)
    Set Items = Folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        PrintAttachments Item
    End If
End Sub

Private Sub PrintAttachments(olItem As Outlook.MailItem)
    On Error Resume Next
    Dim colAtts As Outlook.Attachments
    Dim olAtt As Outlook.Attachment
    Dim sFile As String
    Dim sDirectory As String
    Dim sFileType As String

    sDirectory = "C:\Attachments"

    Set colAtts = olItem.Attachments

    If colAtts.Count Then
        For Each olAtt In colAtts
        '// List file types -
        sFileType = LCase$(Right$(olAtt.FileName, 4))

        Select Case sFileType
            Case ".xls", ".doc"
            sFile = ATTACHMENT_DIRECTORY & olAtt.FileName
            olAtt.SaveAsFile sFile
            ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
            End Select
        Next
    End If
End Sub

Vedere Stampa allegati automaticamente

Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.