Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
dateianhang speichern und in mail verlinken - Fehler
zurück: Benutzerdefiniertes Formular für öffentliche Ordner weiter: Betreff Email: Posteingang auslesen, ab best. Datum möglich? Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Antwort Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Urkle
Gast


Verfasst am:
07. Apr 2014, 10:30
Rufname:

dateianhang speichern und in mail verlinken - Fehler - dateianhang speichern und in mail verlinken - Fehler

Nach oben
       Version: Office 2010

Guten Morgen,
folgenden code habe ich vor Jahren mal gefunden, ist also nicht von mir.
Er speichert Mail-Anhänge und verlinkt in der mail.

ABER:
Sporadisch speichert er nicht in den angegebenen Ordner, löscht aber den Anhang!!!
Im Ordner entsteht ne Daeti mit 0kB und namen "BU" ohne Dateiendung.
So habe ich schon einige Daten verloren.

HAT JEMAND NE AHNUNG, WAS DA LOS IST???

Muss der Code verbessert werden?

Gruß Urkle




Code:

Option Explicit

Type DateiDialogStruktur
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type
 

Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(DateiDialogStruktur As DateiDialogStruktur) As Long
 
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHOWHELP = &H10
 
Dim DateiDialogStruktur As DateiDialogStruktur
 
Function DateiSpeichern(Verzeichnis As String, Fenstertitel As String) As String
On Error GoTo Err_DateiSpeichern
 
    Dim Dateityp As String
    Dim Dateiname_mit_Pfad As String
    Dim Dateiname As String
    Dim Rueckwerte As Long
 
' Dateitypen in der Auswahlliste des Dateityp's
'   Alle Dateien
    Dateityp = Dateityp & "Alle Dateien (*.*)" & Chr$(0) & "*.*" & Chr$(0)
 
' Vorgegebenes Verzeichnis
    If Verzeichnis = "" Then
        ' Wenn leer, dann soll das aktuelle Verzeichnis verwendet werden
        Verzeichnis = CurDir$ & Chr$(0)
    Else
        ' ANSI "0" an das übergebene Verzeichnis anhängen
        Verzeichnis = Verzeichnis & Chr$(0)
    End If
 
    If Fenstertitel = "" Then
        ' Wenn kein Titel übergeben worden ist
        Fenstertitel = "Datei speichern"
    Else
        ' ANSI "0" an übergebenen Fenstertitel anhängen
        Fenstertitel = Fenstertitel & Chr$(0)
    End If
 
' Speicherplatz für Dateieintrag (mit Pfadangabe) reservieren
    Dateiname_mit_Pfad = Space$(255) & "a" & Chr$(0)
 
' Speicherplatz für Dateieintrag (ohne Pfadangabe) reservieren
    Dateiname = Space$(255) & Chr$(0)
 
'Datenstruktur von DateiDialogStruktur festlegen
    DateiDialogStruktur.lStructSize = Len(DateiDialogStruktur)
    DateiDialogStruktur.hwndOwner = 0&
    'DateiDialogStruktur.hwndOwner = Application.hWndAccessApp
    DateiDialogStruktur.lpstrFilter = Dateityp
    DateiDialogStruktur.nFilterIndex = 1
    DateiDialogStruktur.lpstrFile = Dateiname_mit_Pfad
    DateiDialogStruktur.nMaxFile = Len(Dateiname_mit_Pfad)
    DateiDialogStruktur.lpstrFileTitle = Dateiname
    DateiDialogStruktur.nMaxFileTitle = Len(Dateiname)
    DateiDialogStruktur.lpstrInitialDir = Verzeichnis
    DateiDialogStruktur.lpstrTitle = Fenstertitel
    DateiDialogStruktur.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
    DateiDialogStruktur.nFileOffset = 0
    DateiDialogStruktur.nFileExtension = 0
    DateiDialogStruktur.lCustData = 0
    DateiDialogStruktur.lpfnHook = 0
    DateiDialogStruktur.lpTemplateName = ""
 
    Rueckwerte = GetSaveFileName(DateiDialogStruktur)
       
    If Rueckwerte <> 0 Then
        DateiSpeichern = Left(DateiDialogStruktur.lpstrFile, _
        InStr(DateiDialogStruktur.lpstrFile, Chr$(0)) - 2)
   
    Dim myOrt, myDate As String
    Dim myolApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim myTeil, myTeils, myAnhänge, myAnhang, myLink, myLinks, mySubject As Object
    Dim i As Integer
   
   
   ' myDate = Year(Date) & "_" & Month(Date) & "_" & Day(Date) & "_"
    myOrt = DateiSpeichern
       
    On Error Resume Next

    'arbeitet die einzelnen Nachrichten ab
    Set myOlExp = myolApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection

    'für alle Teile...
    For Each myTeil In myOlSel
    'Anhänge festlegen, wenn welche da sind
        Set myAnhänge = myTeil.Attachments
        'Subject bestimmen
        Set mySubject = myTeil.Subject
   
         If myAnhänge.Count > 0 Then
           'fügt einen Hinweis in die Email ein
            myTeil.Body = myTeil.Body & vbCrLf & "Entfernte Anhänge:" & vbCrLf
            'und für alle Anhänge...
           
            For i = 1 To myAnhänge.Count
                                                   
                myAnhänge(i).SaveAsFile myOrt & myAnhänge(i).DisplayName  'nun werden Sie am Speicherort abgelegt
                myTeil.Body = myTeil.Body & "Datei: " & "<" & "file:\\" & myOrt & myAnhänge(i).DisplayName & ">" & vbCrLf  'hier wird Name und der Ort in der Nachricht eingetragen
       
            Next i  'für alle Anhänge...
        While myAnhänge.Count > 0
                myAnhänge.Remove 1
            Wend    'abspeichern ohne Anhang
            myTeil.Save
        End If
        Next
        'free variables
        Set myTeil = Nothing
        Set myTeils = Nothing
        Set myLinks = Nothing
        Set myAnhang = Nothing
        Set myAnhänge = Nothing
        Set myolApp = Nothing
        Set myOlExp = Nothing
        Set myOlSel = Nothing
    Resume

   
    End If

 
Exit_DateiSpeichern:
    Exit Function
 
Err_DateiSpeichern:
    MsgBox Err.Description
    Resume Exit_DateiSpeichern
 
End Function


Sub speichern()
Dim Path As String
 
 Path = DateiSpeichern("C:\Data", "Datei speichern")

End Sub

Urkle
Gast


Verfasst am:
10. Apr 2014, 12:26
Rufname:

AW: dateianhang speichern und in mail verlinken - Fehler - AW: dateianhang speichern und in mail verlinken - Fehler

Nach oben
       Version: Office 2010

keiner ne Idee???
Confused
Michael Bauer
MVP Outlook


Verfasst am:
10. Apr 2014, 12:38
Rufname:
Wohnort: Vollersode


AW: dateianhang speichern und in mail verlinken - Fehler - AW: dateianhang speichern und in mail verlinken - Fehler

Nach oben
       Version: Office 2010

Hallo,

wirf als erstes das On Error Resume Next raus, damit Du Fehlermeldungen erhältst. (Kann gut sein, dass Du dann einiges mehr anpassen mußt, um sämtliche Fehlerquellen zu beseitigen.)

Dann würde ich beide Schleifen zu einer zusammenfassen: Derzeit (eben auch bedingt durch die Fehler-ignorieren Anweisung) werden alle Anhänge gelöscht, auch wenn es beim Speichern Fehler gab.

Du kannst auch vorm Speichern eines Anhangs eine MsgBox einbauen, wenn der Dateiname nur aus "BU" besteht, damit die Codeausführung dann dort anhält. Das gibt Dir die Gelegenheit, das ganze weiter zu untersuchen.

_________________
Michael Bauer
Tools für Microsoft Outlook
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Outlook Mail: Outlook soll keine gesendeten Anlagen speichern 1 Colin 980 23. Mai 2005, 12:49
bernhardh Outlook soll keine gesendeten Anlagen speichern
Keine neuen Beiträge Outlook Mail: mail als gesendet markieren 2 skywalker99 1182 03. Mai 2005, 09:04
kraemer mail als gesendet markieren
Keine neuen Beiträge Outlook Mail: standardordner für "anlagen speichern" definieren? 6 Gast 5419 07. März 2005, 15:58
macdeal standardordner für "anlagen speichern" definieren?
Keine neuen Beiträge Outlook Mail: Abwesenheitsassistent, Mails weiterleiten zu ext. Mail 1 nicksan 1929 22. Feb 2005, 11:45
kraemer Abwesenheitsassistent, Mails weiterleiten zu ext. Mail
Keine neuen Beiträge Outlook Mail: Adressauswahl bei neuem Mail gestört 10 swissbird 912 19. Feb 2005, 15:49
macdeal Adressauswahl bei neuem Mail gestört
Keine neuen Beiträge Outlook Mail: Fehler bei Blindcopy-Mail 3 Seth6945 1210 09. Feb 2005, 11:28
Sassa Fehler bei Blindcopy-Mail
Keine neuen Beiträge Outlook Mail: Mails in Extra Ordner speichern. 4 Jason 2540 30. Jan 2005, 14:51
Christi@n Mails in Extra Ordner speichern.
Keine neuen Beiträge Outlook Mail: manuell mail verschicken 2 redrogue 801 04. Jan 2005, 19:13
redrogue manuell mail verschicken
Keine neuen Beiträge Outlook Mail: Abbruch beim Senden grosserer Mail ... ca. 500 kbytes 1 hlk123 2233 24. Dez 2004, 11:50
hlk123 Abbruch beim Senden grosserer Mail ... ca. 500 kbytes
Keine neuen Beiträge Outlook Mail: Link in Mail umbenennen 4 Marcl 2966 18. Nov 2004, 00:20
wolf-it Link in Mail umbenennen
Keine neuen Beiträge Outlook Mail: Outlook2000 3 Konten - Absender in Mail schnell wechseln 7 ae 2536 03. Nov 2004, 22:46
ae Outlook2000 3 Konten - Absender in Mail schnell wechseln
Keine neuen Beiträge Outlook Mail: Outlook sendet trotzdem Fehler beim ausfü 4 jackdunkel 591 30. Sep 2004, 15:22
tom2ba Outlook sendet trotzdem Fehler beim ausfü
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Dreamweaver Forum