Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Makro kopiert nicht in Zielordner
#1
Hallo VBA Spezialisten,

ich habe da ein kleines Problem (hoffentlich). Das nachfolgende Makro funktioniert soweit, mit Ausnahme zweier Probleme:

  1. Das Makro kopiert die Anhänge nicht in den vorgesehenen Ordner C:/Attachments, sonder meist in den Dokumente Ordner, kann aber auch passieren, dass er sie auf dem Desktop, oder in willkürlich anderen Ordnern ablegt.
  2. Er löscht die Anhänge am Schluss nicht aus dem Ordner in die er sie kopiert hat.
Vielen Dank im Voraus schon für Eure Hilfe.

Hier das Makro:

Code:
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

Public Sub PrintSelectedAttachments()
 Dim Exp As Outlook.Explorer
 Dim Sel As Outlook.Selection
 Dim obj As Object
 Set Exp = Application.ActiveExplorer
 Set Sel = Exp.Selection
 For Each obj In Sel
   If TypeOf obj Is Outlook.MailItem Then
     PrintAttachments obj
   End If
 Next
End Sub

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

 sDirectory = "C:\Attachments"

 Set colAtts = oMail.Attachments

 If colAtts.Count Then
   For Each oAtt In colAtts

     sFileType = LCase$(Right$(oAtt.FileName, 4))

     Select Case sFileType
     Case ".xls", ".doc", ".pdf"
       sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
       oAtt.SaveAsFile sFile
       ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
     End Select
   Next
 End If
End Sub
Antwortento top
#2
Hallöchen,

erst mal zu 1)

Eventuell wäre es angebracht, beim Speichern statt ATTACHMENT_DIRECTORY die von Dir zur Pfaddefinition verwendete Variable sDirectory zu nehmen 21
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#3
...wenn ich ATTACHMENT_DIRECTORY durch sDirectory ersetze passiert gar nichts. Makro wird nicht mehr ausgeführt.
Antwortento top
#4
Hallo!

Entferne mal "On Error Resume Next". Dann werden Fehler angezeigt. Bei "sDirectory" fehlt ein Backslash. sDirectory = "C:\Attachments\"

Gruß, René
Antwortento top
#5
Super vielen Dank!

Das war der Fehler! Der Backslash hat gefehlt.

Vielen vielen DANK an Euch!!!!
Antwortento top
#6
...jetzt ist nur noch die 2. Frage offen: Wie kann ich die kopierten PDF´s im Ordner Attachments am Schluss automatisch wieder löschen?
Antwortento top
#7
Kill sDirectory & oAtt.FileName
Antwortento top
#8
DANKE...sagst Du mir noch wo genau ich das platzieren muss?
Antwortento top
#9
Nach dem Druckbefehl. Allerdings mit einer Wartezeit, damit genug Zeit bleibt um den Druck anzustoßen.
Antwortento top
#10
Besten Dank für Deine Antwort.

Ich möchte aber nicht jede einzelen Datei nach dem drucken löschen, sondern erst wenn alle Dateien in dem Attachments Ornder gedruckt sind. Dann alle löschen.

Hast Du da eine Idee?

DANKE !!
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste