Thema Datum  Von Nutzer Rating
Antwort
05.09.2022 15:43:43 Eugen
NotSolved
05.09.2022 17:58:05 Gast15772
NotSolved
05.09.2022 18:20:20 Gast614
NotSolved
05.09.2022 18:25:18 Gast15772
NotSolved
05.09.2022 18:49:04 Trägheit
NotSolved
05.09.2022 18:52:15 Gast15772
NotSolved
05.09.2022 18:55:54 Trägheit
NotSolved
05.09.2022 18:57:59 Gast15772
NotSolved
05.09.2022 19:23:49 Trägheit
NotSolved
05.09.2022 22:00:28 Mase
NotSolved
08.09.2022 18:30:12 Trägheit
NotSolved
08.09.2022 20:24:47 Mase
NotSolved
Rot Nope, typisches Halbwissen
06.09.2022 08:22:40 volti
NotSolved
05.09.2022 18:17:42 Gast28746
NotSolved
05.09.2022 21:16:18 volti
NotSolved
06.09.2022 13:30:11 Eugen
NotSolved
10.09.2022 13:13:34 Gast4562
Solved

Ansicht des Beitrags:
Von:
volti
Datum:
06.09.2022 08:22:40
Views:
237
Rating: Antwort:
  Ja
Thema:
Nope, typisches Halbwissen

Hallo zusammen,

was ist schon falsch oder nicht falsch. Probieren geht über studieren.

Der vom TE verwendete, angepasste Code kann bei meinem 64-Bit-Office problemlos mit dem Variablentyp Longlong anstelle von LongPtr betrieben werden.

Und wenn ich nur diesen Rechner hier für mich nutze, wo ist das Problem? Außer, dass ich alle Declares anpassen muss,. 

Aber ich ziehe natürlich wie alle anderen auch weiterhin die LongPtr-Version vor.

Code:
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
 
Option Explicit

Private Declare PtrSafe Function MoveWindow Lib "user32.dll" ( _
        ByVal hwnd As LongLongByVal x As Long, _
        ByVal y As LongByVal nWidth As Long, _
        ByVal nHeight As LongByVal bRepaint As LongAs LongLong
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _
        ByVal nIndex As LongAs Long
Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" ( _
        ByVal hwnd As LongLongByRef lpRect As RECTAs Long
Private Declare PtrSafe Function CoTaskMemFree Lib "ole32" ( _
        ByVal hMem As LongLongAs LongLong
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32" ( _
        ByVal pList As LongLongByVal lpBuffer As StringAs LongLong
Private Declare PtrSafe Function SendMessageA Lib "user32.dll" ( _
        ByVal hwnd As LongLongByVal Msg As Long, _
        wParam As LongLong, lParam As AnyAs LongLong

Private Declare PtrSafe Function SHBrowseForFolderA Lib "Shell32.dll" ( _
        lpBrowseInfo As InfoTAs LongLong

Private Type InfoT
     hwnd    As LongLong
     Root    As LongLong
     DisplayName As String
     Title   As String
     Flags   As Long
     FName   As LongLong
     lParam  As LongLong
     Image   As Long
End Type

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

Private s_BrowseInitDir As String
Private Function BrowseCallback( _
  ByVal hwnd As LongLongByVal uMsg As Long, _
  ByVal wParam As LongLongByVal lParam As LongLongAs Long
  If uMsg = &H1 Then
     Call SendMessageA(hwnd, &H466ByVal 1&ByVal s_BrowseInitDir)
     Call CenterDialog(hwnd)
  End If
  BrowseCallback = 0
End Function

Private Function FuncCallback(ByVal nParam As LongLongAs LongLong
  FuncCallback = nParam
End Function


Private Sub CenterDialog(ByVal hwnd As LongLong)
  Dim WinRect As RECT, ScrWidth As Long, ScrHeight As Long
  Dim DlgWidth As Integer, DlgHeight As Integer

  GetWindowRect hwnd, WinRect
  DlgWidth = WinRect.Right - WinRect.Left
  DlgHeight = WinRect.Bottom - WinRect.Top
  ScrWidth = GetSystemMetrics(&H10)
  ScrHeight = GetSystemMetrics(&H11)
  MoveWindow hwnd, (ScrWidth - DlgWidth) / 2, _
  (ScrHeight - DlgHeight) / 2, DlgWidth, DlgHeight, 1
End Sub

Public Function fncGetFolder( _
  Optional ByVal sMsg As String = "Bitte wählen Sie ein Verzeichnis", _
  Optional ByVal sPath As String = "C:\") As String
  Dim xl As InfoT, IDList As LongLong, RVal As LongLong, FolderName As String

  If sPath Like "*.???Or sPath Like "*.????Then
     sPath = Left$(sPath, InStrRev(sPath, "\"))
  End If

  If Dir(sPath, vbDirectory) = "" Then
     sPath = ThisWorkbook.Path
  End If

  s_BrowseInitDir = sPath
  With xl
      .hwnd = Application.hwnd
      .Title = sMsg    ' lstrcat(sMsg, "")
      .Flags = &H1
      .FName = FuncCallback(AddressOf BrowseCallback)
  End With
  IDList = SHBrowseForFolderA(xl)
  If IDList <> 0 Then
     FolderName = Space(256)
     RVal = SHGetPathFromIDList(IDList, FolderName)
     CoTaskMemFree (IDList)
     FolderName = Trim$(FolderName)
     FolderName = Left$(FolderName, Len(FolderName) - 1)
  End If
  fncGetFolder = FolderName
End Function
_________
viele Grüße
Karl-Heinz

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.09.2022 15:43:43 Eugen
NotSolved
05.09.2022 17:58:05 Gast15772
NotSolved
05.09.2022 18:20:20 Gast614
NotSolved
05.09.2022 18:25:18 Gast15772
NotSolved
05.09.2022 18:49:04 Trägheit
NotSolved
05.09.2022 18:52:15 Gast15772
NotSolved
05.09.2022 18:55:54 Trägheit
NotSolved
05.09.2022 18:57:59 Gast15772
NotSolved
05.09.2022 19:23:49 Trägheit
NotSolved
05.09.2022 22:00:28 Mase
NotSolved
08.09.2022 18:30:12 Trägheit
NotSolved
08.09.2022 20:24:47 Mase
NotSolved
Rot Nope, typisches Halbwissen
06.09.2022 08:22:40 volti
NotSolved
05.09.2022 18:17:42 Gast28746
NotSolved
05.09.2022 21:16:18 volti
NotSolved
06.09.2022 13:30:11 Eugen
NotSolved
10.09.2022 13:13:34 Gast4562
Solved