Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  CATIA V5 Programmierung
  Verzeichniswahl

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  Verzeichniswahl (1355 mal gelesen)
Goosnargh
Mitglied



Sehen Sie sich das Profil von Goosnargh an!   Senden Sie eine Private Message an Goosnargh  Schreiben Sie einen Gästebucheintrag für Goosnargh

Beiträge: 80
Registriert: 30.11.2004

erstellt am: 26. Apr. 2007 16:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Moin,

ich kann über CATIA.FileSelectionBox ja Dateien auswählen.
Weiss jemand, ob ich auch Ordner auswählen kann?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Proofin
Mitglied
Dpl.Ing


Sehen Sie sich das Profil von Proofin an!   Senden Sie eine Private Message an Proofin  Schreiben Sie einen Gästebucheintrag für Proofin

Beiträge: 208
Registriert: 24.11.2004

erstellt am: 26. Apr. 2007 16:46    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Goosnargh 10 Unities + Antwort hilfreich

Moin Goosnargh,

meines Wissens nach gibt es mit Catia Mitteln keine Möglichkeit einen
Ordnerauswahl Dialog anzuzeugen.

Gruß
Proofin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Bertel
Mitglied



Sehen Sie sich das Profil von Bertel an!   Senden Sie eine Private Message an Bertel  Schreiben Sie einen Gästebucheintrag für Bertel

Beiträge: 300
Registriert: 03.04.2002

CATIA V5 R26SP3HF21
Win10
Lenovo P52
Intel Xenon 16GB Ram
NVIDIA Quadro P2000
EUKLID V14
ViCADo 2015

erstellt am: 26. Apr. 2007 16:57    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Goosnargh 10 Unities + Antwort hilfreich

Hallo Goosnargh,

meinst du sowas?

Dim Ordner As Folder
Set Ordner = CATIA.FileSystem.GetFolder("C:\irgendeinOrdner")
Dim Dateien As Files
Set Dateien = Ordner.Files

Dim Datei As File

'------------------------------------------
' Schleife über alle Dateien in Dir
'-------------------------------------------


For i = 1 to Dateien.count
Set Datei = Dateien.Item(i)
if (InStr(Datei.Name,"CATDrawing")) then  ' wenn Datei ein CATDrawing
            ' irgendwas mit der Datei machen
end if
Next

Gruß
Bertel

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Tstone
Mitglied
Werkzeugkonstrukteur


Sehen Sie sich das Profil von Tstone an!   Senden Sie eine Private Message an Tstone  Schreiben Sie einen Gästebucheintrag für Tstone

Beiträge: 163
Registriert: 04.06.2003

Dell Precision 470
Intel Xeon CPU 3,00GHz
2GB Ram
Microsoft Windows XP
Catia V5 R18 SP6
VB2005

erstellt am: 27. Apr. 2007 08:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Goosnargh 10 Unities + Antwort hilfreich

Hi
versuche mal das:

Dim Shell As Object
Dim Ordner As String
Set Shell = CreateObject("Shell.Application")
Ordner = Shell.BrowseForFolder(0, "Wählen Sie", 0).Self.Path

------------------
Grüße TStone
   "Respektiere die Macht der Worte, wähle sie mit Bedacht!"

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Goosnargh
Mitglied



Sehen Sie sich das Profil von Goosnargh an!   Senden Sie eine Private Message an Goosnargh  Schreiben Sie einen Gästebucheintrag für Goosnargh

Beiträge: 80
Registriert: 30.11.2004

erstellt am: 27. Apr. 2007 10:57    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hi,
danke, BrowseForFolder verwende ich schon.
Das dumme ist nur, dass ich mich da entweder durch alle Festplatten zum verzeichnis durchwühlen muss, oder ein Startverzeichnis vorgebe und dann komme ich nicht weiter "nach oben" im Verzeichnisbaum....

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

AEnnenbach
Mitglied
CAD-Engineer


Sehen Sie sich das Profil von AEnnenbach an!   Senden Sie eine Private Message an AEnnenbach  Schreiben Sie einen Gästebucheintrag für AEnnenbach

Beiträge: 25
Registriert: 12.04.2001

CATIA V5 R16 SP5
UG NX 3
Win XP x64
IBM M-Pro Core2 2.2GHz 4GB
Nvidia FX1500

erstellt am: 27. Apr. 2007 12:00    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Goosnargh 10 Unities + Antwort hilfreich

Mahlzeit 

Vor nicht wenigen Wochen hatte ich ein ähnliches Problem und bin dann im Netz auf folgende Klasse gestoßen:

Code:

'// ---------------------------------------------------------------------------
'// Klasse:    cSHFolder.cls
'//            Kapselt den Zugriff auf den "Ordner auswählen" Dialog
'//
'// Zur Nutzung muss das Modul "modSHFolder" im Projekt enthalten sein.
'//
'// Copyright:  ©1998-2001 Thorsten Dörfler (doerfler.t@vb-hellfire.de)
'//            http://www.vb-hellfire.de
'// ---------------------------------------------------------------------------
Option Explicit
Option Compare Text

Private Type BROWSEINFO
  hWndOwner      As Long
  pIDLRoot      As Long
  pszDisplayName As String
  lpszTitle      As String
  ulFlags        As Long
  lpfnCallback  As Long
  lParam        As Long
  iImage        As Long
End Type

Private Type RECT
  Left  As Long
  Top    As Long
  Right  As Long
  Bottom As Long
End Type

Private Const WM_USER = &H400
Private Const SWP_NOSIZE = 1
Private Const SWP_NOZORDER = 4
Private Const MAX_PATH = 260

'// BROWSEINFO ulFlags:
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
' ab Shell32 4.71 (IE4/Win98)
Private Const BIF_EDITBOX = &H10
Private Const BIF_VALIDATE = &H32
Private Const BIF_BROWSEINCLUDEFILES = &H4000
' ab Shell32 5.0 (Win2000)
Private Const BIF_NEWDIALOGSTYLE = &H40

'// Gesendete CallBack Nachrichten:
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
' ab Shell32 4.71 (IE4/Win98)
Private Const BFFM_VALIDATEFAILED = 3

'// Zu sendende Nachrichten:
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_ENABLEOK = (WM_USER + 101)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hWndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long

Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long

Public Enum ShellSpecialFolderConstants
  CSIDL_DESKTOP = 0&                    'Alle Ressourcen ab Desktop
  CSIDL_PROGRAMS = &H2&                'Startmenü Programme <aktueller Benutzer>
  CSIDL_PRINTERS = &H4&                'Drucker
  CSIDL_PERSONAL = &H5&                'Eigene Dateien      <aktueller Benutzer>
  CSIDL_FAVORITES = &H6&                'Favoriten          <aktueller Benutzer>
  CSIDL_STARTMENU = &HB&                'Gesamtes Startmenü  <aktueller Benutzer>
  CSIDL_DESKTOPDIRECTORY = &H10&        'Desktop (Ordner)    <aktueller Benutzer>
  CSIDL_DRIVES = &H11&                  'Arbeitsplatz
  CSIDL_NETWORK = &H12&                'Netzwerkumgebung
  CSIDL_NETHOOD = &H13&                'Netzwerkumgebung (Ordner)
  CSIDL_FONTS = &H14&                  'Fonts (Ordner)
  CSIDL_TEMPLATES = &H15&              'Vorlagen (Ordner)
  CSIDL_COMMON_STARTMENU = &H16&        'Gesamtes Startmenü  <alle Benutzer>
  CSIDL_COMMON_PROGRAMS = &H17&        'Startmenü Programme <alle Benutzer>
  CSIDL_COMMON_STARTUP = &H18&          'Autostart (Ordner)  <alle Benutzer>
  CSIDL_COMMON_DESKTOPDIRECTORY = &H18& 'Destop (Ordner)    <alle Benutzer>
  CSIDL_APPDATA = &H1A&                'Anwendungsdaten    <aktueller Benutzer> (ab Shell32 4.71)
  CSIDL_PRINTHOOD = &H1B&              'Druckumgebung (Ordner)
  CSIDL_ALTSTARTUP = &H1D&              'Altern. Autostart (Ordner) <aktueller Benutzer>
  CSIDL_COMMON_ALTSTARTUP = &H1E&      'Altern. Autostart (Ordner) <alle Benutzer>
  CSIDL_COMMON_FAVORITES = &H1F&        'Favoriten                  <alle Benutzer>
  CSIDL_INTERNET_CACHE = &H20&          'Temp. Internet Files                    (ab Shell32 4.72)
  CSIDL_COOKIES = &H21&                'Internet Cookies (Ordner)
  CSIDL_HISTORY = &H22&                'Internet Verlauf (Ordner)
  ' ab Shell32 5.0 (Win2000)
  CSIDL_COMMON_APPDATA = &H23          'Anwendungsdaten          <alle Benutzer>
  CSIDL_WINDOWS = &H24                  'GetWindowsDirectory()
  CSIDL_SYSTEM = &H25                  'GetSystemDirectory()
  CSIDL_PROGRAM_FILES = &H26            'Programme
  CSIDL_MYPICTURES = &H27              'Eigene Bilder
  CSIDL_PROFILE = &H28                  'Dokumente & Einstellungen
  CSIDL_PROGRAM_FILES_COMMON = &H2B    'Gemeinsame Dateien
  CSIDL_COMMON_TEMPLATES = &H2D        'Vorlagen (Ordner)        <alle Benutzer>
  CSIDL_COMMON_DOCUMENTS = &H2E        'Dokumente                <alle Benutzer>
  CSIDL_COMMON_ADMINTOOLS = &H2F        'Startmenü "Verwaltung"  <alle Benutzer>
  CSIDL_ADMINTOOLS = &H30              'Startmenü "Verwaltung"  <aktueller Benutzer>
  CSIDL_CONNECTIONS = &H31              'Netzwerk- und DFÜ-Verbindungen
End Enum

'// Eigenschaften:
Private pbol_CenterDialog  As Boolean
Private pbol_EditBox        As Boolean
Private pbol_IncludeFiles  As Boolean
Private pbol_NewDialog      As Boolean
Private pbol_StatusTextArea As Boolean
Private pstr_Caption        As String
Private pstr_ValidFolder    As String
Private pstr_DefaultPath    As String
Private pstr_StatusText    As String
Private pstr_DisplayName    As String
Private plng_hWnd          As Long
Private pudt_DefaultPIDL    As ShellSpecialFolderConstants

Public Event Initialized()
Public Event SelectionChanged(ByVal PathSelected As String)
Public Event ValidationFailed(ByVal InvalidPath As String, ByRef Cancel As Boolean)

'// ---------------------------------------------------------------------------
'// Eigenschaft:  DisplayName
'//              Gibt den Titel des ausgewählten Elements zurück.
'// ---------------------------------------------------------------------------
Public Property Get DisplayName() As String
  DisplayName = pstr_DisplayName
End Property

Private Function pPtrToStr(ByVal lPtr As Long) As String
  Dim strBuffer As String
 
  strBuffer = Space$(lstrlen(lPtr))
  lstrcpy strBuffer, lPtr
 
  pPtrToStr = strBuffer
End Function

'// BrowseCallback Empfängerprozedur:
Friend Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
  Dim bolIsValid  As Boolean
  Dim strPath    As String
  Dim bolCancel  As Boolean

  Select Case uMsg
    Case BFFM_INITIALIZED
      plng_hWnd = hWnd  '// Handle speichern
     
      '// Dialogtitel/Statustext/DefaultPIDL|Path festlegen:
      If pstr_Caption <> vbNullString Then Me.Caption = pstr_Caption
      If pstr_StatusText <> vbNullString Then Me.StatusText = pstr_StatusText
      If pudt_DefaultPIDL <> vbEmpty Then Me.DefaultPIDL = pudt_DefaultPIDL
      If pstr_DefaultPath <> vbNullString Then Me.DefaultPath = pstr_DefaultPath

      '// Dialog ggf. zentrieren:
      If (pbol_CenterDialog) Then Me.CenterDialog = True
     
      RaiseEvent Initialized
     
  Case BFFM_SELCHANGED
    '// Nur bestimmte Dateien/Verzeichnisse zur Auswahl zulassen:
    If pstr_ValidFolder <> vbNullString Then
      strPath = pPathFromPIDL(lParam)
     
      Me.OKEnabled = (strPath Like "*" & pstr_ValidFolder)
    End If
   
    RaiseEvent SelectionChanged(pPathFromPIDL(lParam))
 
  Case BFFM_VALIDATEFAILED
 
    RaiseEvent ValidationFailed(pPtrToStr(lParam), bolCancel)

    BrowseCallbackProc = CLng(Not bolCancel)
  End Select
End Function

'// ---------------------------------------------------------------------------
'// Eigenschaft:  DefaultPath
'//              String. Legt den Pfad fest, der selektiert und expandiert
'//              dargestellt werden soll.
'// ---------------------------------------------------------------------------
Public Property Let DefaultPath(ByVal New_Value As String)
 
  pstr_DefaultPath = New_Value
 
  If (plng_hWnd <> 0) Then
    SendMessage plng_hWnd, BFFM_SETSELECTION, True, ByVal New_Value
  End If
End Property

'// ---------------------------------------------------------------------------
'// Eigenschaft:  DefaultPIDL
'//              ShellSpecialFolder Konstante. Legt den Pfad fest über eine
'//              CSIDL fest, der selektiert und expandiert dargestellt werden
'//              soll.
'// ---------------------------------------------------------------------------
Public Property Let DefaultPIDL(ByVal New_Value As ShellSpecialFolderConstants)
  Dim lngRootPIDL As Long
 
  pudt_DefaultPIDL = New_Value
 
  If (plng_hWnd <> 0) Then
    SHGetSpecialFolderLocation plng_hWnd, New_Value, lngRootPIDL
    SendMessage plng_hWnd, BFFM_SETSELECTION, False, ByVal lngRootPIDL
  End If
End Property

'// ---------------------------------------------------------------------------
'// Eigenschaft:  OKEnabled
'//              Boolesch. Legt fest, ob der OK Button freigegeben oder
'//              gesperrt ist (nur während der Anzeige des Dialogs gültig)
'// ---------------------------------------------------------------------------
Public Property Let OKEnabled(ByVal New_Value As Boolean)
  If (plng_hWnd <> 0) Then
    SendMessage plng_hWnd, BFFM_ENABLEOK, 0, ByVal CLng(New_Value)
  End If
End Property

Private Function pPathFromPIDL(ByVal PIDL As Long) As String
  Dim strPath As String
 
  If (PIDL <> 0) Then
    strPath = Space$(MAX_PATH)
    SHGetPathFromIDList PIDL, strPath
    strPath = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
  Else
    strPath = vbNullString
  End If
 
  pPathFromPIDL = strPath
End Function

'// ---------------------------------------------------------------------------
'// Eigenschaft:  StatusText
'//              String. Legt den Text fest, der im Statusbereich unterhalb
'//              des Dialogtitel angezeigt werden soll.
'// ---------------------------------------------------------------------------
Public Property Let StatusText(ByVal New_Value As String)
  If plng_hWnd = 0 Then
    pstr_StatusText = New_Value
  Else
    If (pbol_StatusTextArea) Then
      SendMessage plng_hWnd, BFFM_SETSTATUSTEXT, 0, ByVal New_Value
    End If
  End If
End Property

'// ---------------------------------------------------------------------------
'// Eigenschaft:  hWnd
'//              Long. Gibt den Handle des Dialogs zurück.
'// ---------------------------------------------------------------------------
Public Property Get hWnd() As Long
  hWnd = plng_hWnd
End Property

'// ---------------------------------------------------------------------------
'// Eigenschaft:  NewDialog
'//              Boolesch. Legt fest, ob der Dialog im erweitertem Stil (ab
'//              Windows 2000) angezeigt werden soll.
'// ---------------------------------------------------------------------------
Public Property Let NewDialog(ByVal New_Value As Boolean)
  pbol_NewDialog = New_Value
End Property

'// ---------------------------------------------------------------------------
'// Eigenschaft:  StatusTextArea
'//              Boolesch. Legt fest, ob ein Statusbereich unterhalb des
'//              Titels angezeigt werden soll.
'// ---------------------------------------------------------------------------
Public Property Let StatusTextArea(ByVal New_Value As Boolean)
  pbol_StatusTextArea = New_Value
End Property

'// ---------------------------------------------------------------------------
'// Eigenschaft:  ValidFolder
'//              Boolesch. Legt fest, welche Dateinamen eine zulässige
'//              Auswahl darstellen. Platzhalter sind erlaubt.
'// ---------------------------------------------------------------------------
Public Property Let ValidFolder(ByVal New_Value As String)
  pstr_ValidFolder = New_Value
End Property

'// ---------------------------------------------------------------------------
'// Eigenschaft:  Caption
'//              String. Legt fest, welcher Text in der Titelzeile des Dialogs
'//              angezeigt werden soll.
'// ---------------------------------------------------------------------------
Public Property Let Caption(ByVal New_Value As String)
  pstr_Caption = New_Value
 
  If (plng_hWnd <> 0) Then
    SetWindowText plng_hWnd, New_Value
  End If
End Property

'// ---------------------------------------------------------------------------
'// Funktion: BrowseForFolder
'//          Zeigt den "Ordner auswählen" Dialog an.
'// Parameter:
'//  [Parent]    => Form/UserControl Objekt zu dem der Dialog modal angezeigt wird
'//  [Title]      => Zeichenfolge, die im Dialog angezeigt werden soll
'//  [RootFolder] => ShellSpecialFolder Konstante, die den Startordner angibt
'//
'// Rückgabe:    => Zeichenfolge, die den gewählten Pfad angibt bzw.
'//                  vbNullString, wenn "Abbrechen" gewählt wurde.
'// ---------------------------------------------------------------------------
Public Function BrowseForFolder(Optional Parent As Variant, _
                                Optional Title As Variant, _
                                Optional RootFolder As ShellSpecialFolderConstants = CSIDL_DESKTOP) As String
                               
    Dim tBI        As BROWSEINFO
    Dim lhWndParent As Long
    Dim lngOptions  As Long
    Dim lngRootPIDL As Long
    Dim lngPIDL    As Long
   
    If IsMissing(Parent) = False Then lhWndParent = 0 'Parent.hWnd
    If IsMissing(Title) Then Title = "Wählen Sie einen Ordner aus"
   
    '// Optionen entsprechend den Eigenschaften setzen:
    lngOptions = BIF_RETURNONLYFSDIRS
    If (pbol_IncludeFiles) Then lngOptions = lngOptions Or BIF_BROWSEINCLUDEFILES
    If (pbol_StatusTextArea) Then lngOptions = lngOptions Or BIF_STATUSTEXT
    If (pbol_EditBox) Then lngOptions = lngOptions Or BIF_EDITBOX Or BIF_VALIDATE
    If (pbol_NewDialog) Then lngOptions = lngOptions Or BIF_NEWDIALOGSTYLE
   
    '// Eigentlich sollte sich pIDLRoot mit einer CSIDL - Konstante zufrieden
    '// geben, wenn man aber den erweiterten Dialog Stil BIF_NEWDIALOGSTYLE ab
    '// Win2000 nutzen will, muss die CSIDL Konstante in einen PIDL konvertiert
    '// werden, da ansonsten die Anwendung abgeschossen wird. Warum? Wer es weiß,
    '// darf es mir sagen.
    SHGetSpecialFolderLocation lhWndParent, RootFolder, lngRootPIDL

    With tBI
      .hWndOwner = lhWndParent
      .pszDisplayName = Space$(MAX_PATH)
      .pIDLRoot = lngRootPIDL
      .ulFlags = lngOptions
      .lpszTitle = Title
      .lpfnCallback = pGetProcAddress(AddressOf modSHFolder.BrowseCallbackProc)
    End With
   
    modSHFolder.Attach Me
   
    lngPIDL = SHBrowseForFolder(tBI)
   
    modSHFolder.Detach
   
    plng_hWnd = 0
   
    If pPathFromPIDL(lngPIDL) <> vbNullString Then
      pstr_DisplayName = Left$(tBI.pszDisplayName, InStr(1, tBI.pszDisplayName, Chr$(0)) - 1)
    End If
   
    BrowseForFolder = pPathFromPIDL(lngPIDL)
   
    CoTaskMemFree lngPIDL
End Function

'// ---------------------------------------------------------------------------
'// Eigenschaft:  CenterDialog
'//              Boolesch. Legt fest, ob der Dialog bildschirmmittig angezeigt
'//              werden soll.
'// ---------------------------------------------------------------------------
Public Property Let CenterDialog(ByVal New_Value As Boolean)
  Dim tRC    As RECT
  Dim lngLeft As Long
  Dim lngTop  As Long
 
  pbol_CenterDialog = New_Value
 
  If (plng_hWnd <> 0) Then
    If (New_Value) Then
      GetWindowRect plng_hWnd, tRC
     
      With tRC
        lngLeft = (Screen.Width \ Screen.TwipsPerPixelX - .Right + .Left) \ 2
        lngTop = (Screen.Height \ Screen.TwipsPerPixelY - .Bottom + .Top) \ 2
      End With
     
      SetWindowPos plng_hWnd, 0, lngLeft, lngTop, 0, 0, SWP_NOSIZE Or SWP_NOZORDER
    End If
  End If
End Property

'// ---------------------------------------------------------------------------
'// Eigenschaft:  EditBox
'//              Boolesch. Legt fest, ob ein Eingabefeld zur manuellen
'//              Pfadangabe angezeigt wird. (ab Shell32 4.71)
'// ---------------------------------------------------------------------------
Public Property Let EditBox(ByVal New_Value As Boolean)
  pbol_EditBox = New_Value
End Property

'// ---------------------------------------------------------------------------
'// Eigenschaft:  IncludeFiles
'//              Boolesch. Legt fest, ob neben den Verzeichnissen auch Dateien
'//              zur Auswahl stehen (ab Shell32 4.71).
'// ---------------------------------------------------------------------------
Public Property Let IncludeFiles(New_Value As Boolean)
  pbol_IncludeFiles = New_Value
End Property

Private Function pGetProcAddress(ByVal ProcAddress As Long)
  pGetProcAddress = ProcAddress
End Function



##########################################

Code:

'// ---------------------------------------------------------------------------
'// Modul:      modSHFolder
'//            Enthält Empfängerprozudur des BrowseCallback
'//
'// Copyright:  ©1999-2001 Thorsten Dörfler (doerfler.t@vb-hellfire.de)
'//            http://www.vb-hellfire.de
'// ---------------------------------------------------------------------------
Option Explicit

Private objCallBack As cSHFolder

Public Sub Attach(CallBack As cSHFolder)
  Set objCallBack = CallBack
End Sub

Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
  '// CallBack ungefiltert der Klasse zur weiteren Bearbeitung übergeben:
  BrowseCallbackProc = objCallBack.BrowseCallbackProc(hWnd, uMsg, lParam, lpData)
End Function

Public Sub Detach()
  Set objCallBack = Nothing
End Sub



##########################################

Aufgerufen wird das ganze so:

##########################################

Code:

Function getFolder(sStartPath as String)
  getFolder = ""
  With SHFolder
   
    .StatusTextArea = True
    .IncludeFiles = False
    .NewDialog = True
    .EditBox = True
    .DefaultPath = sStartPath
    .ValidFolder = ""
    sPath = .BrowseForFolder(Me, , CSIDL_DRIVES)
    If sPath <> "" Then
getFolder = sPath
    End If
  End With
End Function


#############################################################

Das funktioniert (zumindest bei meinem Projekt) einwandfrei.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Goosnargh
Mitglied



Sehen Sie sich das Profil von Goosnargh an!   Senden Sie eine Private Message an Goosnargh  Schreiben Sie einen Gästebucheintrag für Goosnargh

Beiträge: 80
Registriert: 30.11.2004

erstellt am: 27. Apr. 2007 13:26    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Puh, das ist lang.

Danke, ich werde das mal beizeiten ausprobieren. So beim ersten vorsichigen kopieren war aber ne Menge rot.....

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

AEnnenbach
Mitglied
CAD-Engineer


Sehen Sie sich das Profil von AEnnenbach an!   Senden Sie eine Private Message an AEnnenbach  Schreiben Sie einen Gästebucheintrag für AEnnenbach

Beiträge: 25
Registriert: 12.04.2001

CATIA V5 R16 SP5
UG NX 3
Win XP x64
IBM M-Pro Core2 2.2GHz 4GB
Nvidia FX1500

erstellt am: 27. Apr. 2007 13:56    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Goosnargh 10 Unities + Antwort hilfreich


GetFolder.zip

 
Das ganze sind 2, bzw. 3 Module und funktioniert auch nur unter vba.

Der 1. Part (Codeblock) ist ein Klassenmodul (cSHFolder)
Der 2. Part ist ein normales Modul (modSHFolder)

Die beiden Module müssen auch unter diesen Namen ins Projekt eingefügt werden. (Insert->Class Module, bzw. Insert->Module)

Der 3. Codeblock ist eine Funktion, die in irgendeinem Modul, bzw. in einem Formular eingebaut werden kann und soll nur den Gebrauch der Klasse verdeutlichen.


Hab's hier auch mal als Attachment angehängt...

[Diese Nachricht wurde von AEnnenbach am 27. Apr. 2007 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

AEnnenbach
Mitglied
CAD-Engineer


Sehen Sie sich das Profil von AEnnenbach an!   Senden Sie eine Private Message an AEnnenbach  Schreiben Sie einen Gästebucheintrag für AEnnenbach

Beiträge: 25
Registriert: 12.04.2001

CATIA V5 R16 SP5
UG NX 3
Win XP x64
IBM M-Pro Core2 2.2GHz 4GB
Nvidia FX1500

erstellt am: 09. Mai. 2007 09:53    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Goosnargh 10 Unities + Antwort hilfreich

Hat das jetzt eigentlich funktioniert? 

Und wenn nicht, wo sind die Probleme? 

Gruß Achim 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz