FileDialog unter anderen Windows-/Excel-Vers.

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: FileDialog unter anderen Windows-/Excel-Vers.
von: Michael
Geschrieben am: 26.04.2005 12:00:21
Hallo!
Habe unter großer Hilfe dieses Forums hier für meine Kollegen das folgende Makro erstellt, dass auf die in einem Ordner vorhandenen Dateien mit ihrem Dateinamen (z.B. Name.doc) auflistet. Bei mir (Windows XP / Excel 2003) läuft es auch super, nur bei ihnen nicht (Windows 2000/NT - Excel 2000), der Debugger zeigt die Zeile
"With Application.FileDialog(4)"
als Fehler an...
Gibt es Hoffnung?
Danke schon jetzt für eure Hilfe,
Michael

Sub Hyperlinks_einfügen()
Dim strFolder As String
Dim icount As Integer
Dim i As Integer
Dim j As Integer
Worksheets(1).Columns(9).Clear
With Application.FileDialog(4)
.InitialFileName = "V:\Verkauf Export 3+4\SONDERMAPPE\"
.Title = "Ordner auswählen"
.ButtonName = "Auswahl"
.InitialView = 2
If .Show = -1 Then
strFolder = .SelectedItems(1)
Else
MsgBox "Keine Auswahl getroffen!"
Exit Sub
End If
End With
With Application.FileSearch
.NewSearch
.LookIn = strFolder
.Filename = "*.*"
.SearchSubFolders = False
.Execute
icount = .FoundFiles.Count
For i = 1 To icount
Worksheets(1).Hyperlinks.Add anchor:=Worksheets(1).Cells(6 + i, 9), Address:=.FoundFiles(i)
For j = Len(Cells(6 + i, 9)) To 1 Step -1
If Cells(6 + i, 9).Characters(j, 1).Text = "\" Then
Cells(6 + i, 9) = Right(Cells(6 + i, 9), Len(Cells(6 + i, 9)) - j)
Exit For
End If
Next j
Next i
End With
Worksheets(1).Columns("I:I").AutoFit

Bild

Betrifft: AW: FileDialog unter anderen Windows-/Excel-Vers.
von: Frank Domke
Geschrieben am: 27.04.2005 11:40:55
Hallo Michael,
ich habe hier eine Lösung, die Du einbauen könntest. Ich habe diese aus dem Internet, weiß aber nicht mehr von wem, sorry an den Autor!
Kopiere alles in ein separates Modul und rufe es wie im

Sub sBeispiel beschrieben auf.
Ein Nachteil hat die Routine, Du kannst nicht den Startpfad vorbelegen.
Viel Erfolg
Frank.
Option Explicit
Option Private Module
'this will allow you to browse for folder starting at your desktop.
Public Type BROWSEINFO
    hwndOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    pszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Const MAX_PATH As Long = 260
Const dhcErrorExtendedError = 1208&
Const dhcNoError = 0&
'specify root dir for browse for folder by constants
'you can also specify values by constants for searhcable folders and options.
Const dhcCSIdlDesktop = &H0
Const dhcCSIdlPrograms = &H2
Const dhcCSIdlControlPanel = &H3
Const dhcCSIdlInstalledPrinters = &H4
Const dhcCSIdlPersonal = &H5
Const dhcCSIdlFavorites = &H6
Const dhcCSIdlStartupPmGroup = &H7
Const dhcCSIdlRecentDocDir = &H8
Const dhcCSIdlSendToItemsDir = &H9
Const dhcCSIdlRecycleBin = &HA
Const dhcCSIdlStartMenu = &HB
Const dhcCSIdlDesktopDirectory = &H10
Const dhcCSIdlMyComputer = &H11
Const dhcCSIdlNetworkNeighborhood = &H12
Const dhcCSIdlNetHoodFileSystemDir = &H13
Const dhcCSIdlFonts = &H14
Const dhcCSIdlTemplates = &H15
'constants for limiting choices for BrowseForFolder Dialog
Const dhcBifReturnAll = &H0
Const dhcBifReturnOnlyFileSystemDirs = &H1
Const dhcBifDontGoBelowDomain = &H2
Const dhcBifIncludeStatusText = &H4
Const dhcBifSystemAncestors = &H8
Const dhcBifBrowseForComputer = &H1000
Const dhcBifBrowseForPrinter = &H2000
'... you can get a lot more of these values from your integrated API viewer for constant specifcation or go to AllPai.net and see their samples.
Public Declare 

Function SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long
'corrected
Public Declare 

Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                                                   (ByVal hwndOwner As Long, ByVal nFolder As Long, ByRef pidl As Long) As Long
Public Declare 

Function SHGetPathFromIDList Lib "shell32" _
                                            (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public 

Sub sBeispiel()
    Dim strPath As String
    'now fill the strPath with the choice by user
    Call BrowseForFolder(dhcCSIdlDesktop, dhcBifReturnOnlyFileSystemDirs, _
                         strPath, pszTitle:="Bitte wählen Sie einen Ordner:")
End Sub

Public

Function BrowseForFolder(ByVal lngCSIDL As Long, _
                                ByVal lngBiFlags As Long, _
                                strFolder As String, _
                                Optional ByVal hWnd As Long = 0, _
                                Optional pszTitle As String = "Auswahl Ordner") As Long
    Dim usrBrws As BROWSEINFO
    Dim lngReturn As Long
    Dim lngIDL As Long
    If SHGetSpecialFolderLocation(hWnd, lngCSIDL, lngIDL) = 0 Then
        'set up the browse structure here
        With usrBrws
            .hwndOwner = hWnd
            .pidlRoot = lngIDL
            .pszDisplayName = String$(MAX_PATH, vbNullChar)
            .pszTitle = pszTitle
            .ulFlags = lngBiFlags
        End With
        'open the dialog
        lngIDL = SHBrowseForFolder(usrBrws)
        'if successful
        If lngIDL Then strFolder = String$(MAX_PATH, vbNullChar)
        'resolve the long value form the lngIDL to a real path
        If SHGetPathFromIDList(lngIDL, strFolder) Then
            strFolder = Left(strFolder, InStr(1, strFolder, vbNullChar))
            lngReturn = dhcNoError                                   'to show there is no error.
        Else
            'nothing real is available.
            'return a virtual selection
            strFolder = Left(usrBrws.pszDisplayName, InStr(1, usrBrws.pszDisplayName, vbNullChar))
            lngReturn = dhcNoError                                   'to show there is no error.
        End If
    Else
        lngReturn = dhcErrorExtendedError                            'something went wrong
    End If
    BrowseForFolder = lngReturn
End Function

 Bild

Beiträge aus den Excel-Beispielen zum Thema "FileDialog unter anderen Windows-/Excel-Vers."