Clever-Excel-Forum

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

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

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

Hallo André,

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

lg

Olli

friedensbringer

schauan

friedensbringer