Exportieren von Mails inklusive Absender / Datum

[friedensbringer]

Hallo zusammen,

ich würde gerne Emails aus einem Ordner in Outlook 2013 (64 Bit) in einen Ordner exportieren.
Wenn ich das via Drag & Drop mache gehen leider Informationen wie zB das Datum und der Absender verloren.

Jetzt hätte ich da ein Skript gefunden welches das können sollte, aber leider unter Outlook 2013 (64 Bit) nicht mehr funktioniert.

http://sw-guide.de/microsoft-outlook/scr...estplatte/

Das hier habe ich schon einmal angepasst:

x86: Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
x64: Private Declare PtrSafe Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Jetzt stürzt Outlook aber hier an dieser Stelle ab:

lpIDList = SHBrowseForFolder(udtBI) 'hier Crasht das Makro
If lpIDList = 0 Then Exit Function

Ich habe hier folgendes gelesen:

http://msdn.microsoft.com/en-us/library/...s.85).aspx

For Windows Vista or later, it is recommended that you use IFileDialog with the FOS_PICKFOLDERS option rather than the SHBrowseForFolder function. This uses the Open Files dialog in pick folders mode and is the preferred implementation.

Kann mir hier eventuell jemand mit VBA Kenntnissen weiterhelfen wie man IFileDialog korrekt verwendet?

Vielen Dank und lg

Olli

[schauan]

Hallo Olli,

als Hilfe für 64bit - Versionen schaue ich gern auf diese Seite:
http://www.jkp-ads.com/articles/apideclarations.asp

Zur Ordnerwahl nutze ich übrigens das:

Code:

Function BrowseForFolder(Optional OpenAt As String) As String
    
    Dim ShellApp As Object
    
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then
            BrowseForFolder = ""
        End If
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then
            BrowseForFolder = ""
        End If
    Case Else
        BrowseForFolder = ""
    End Select
    
ExitFunction:
    Set ShellApp = Nothing
End Function

[friedensbringer]

Hallo André,

vielen Dank für die Info - werde mal versuchen das bei Gelegenheit entsprechend einzubauen.

lg

Olli