Hallo,
ich hatte mal was gebastelt, was mich arg in schwitzen brachte. Jedoch brauche ich dies nun nicht mehr und entferne es aus meinem Project. Denke aber mal das sicherlich jemand diese Sub brauch.
Jeder kennt das Problem. Man möchte eine Datei öffnen oder speichern und brauch dazu ein Password. Also lässt man erst ein Fenster aufploppen zur eingabe des Passwordes und dann nochmal den Öffnen oder Speichern Dialog.
Mit dieser Routine brauch man dies nicht mehr 
'Code im Klassenmodul cCommonDialog
Option Explicit
Const WM\_USER = &H400
Const WM\_DESTROY = &H2
Const WM\_NOTIFY = &H4E
Const WM\_NCDESTROY = &H82
Const WM\_GETDLGCODE = &H87
Const WM\_INITDIALOG = &H110
Const CDN\_FIRST = (-601)
Const CDN\_LAST = (-699)
Const CDN\_INITDONE = (CDN\_FIRST - &H0)
Const CDN\_SELCHANGE = (CDN\_FIRST - &H1)
Const CDN\_FOLDERCHANGE = (CDN\_FIRST - &H2)
Const CDN\_SHAREVIOLATION = (CDN\_FIRST - &H3)
Const CDN\_HELP = (CDN\_FIRST - &H4)
Const CDN\_FILEOK = (CDN\_FIRST - &H5)
Const CDN\_TYPECHANGE = (CDN\_FIRST - &H6)
Const CDN\_INCLUDEITEM = (CDN\_FIRST - &H7)
Const CDM\_FIRST = (WM\_USER + 100)
Const CDM\_LAST = (WM\_USER + 200)
Const CDM\_GETSPEC = (CDM\_FIRST + &H0)
Const CDM\_GETFILEPATH = (CDM\_FIRST + &H1)
Const CDM\_GETFOLDERPATH = (CDM\_FIRST + &H2)
Const CDM\_GETFOLDERIDLIST = (CDM\_FIRST + &H3)
Const CDM\_SETCONTROLTEXT = (CDM\_FIRST + &H4)
Const CDM\_HIDECONTROL = (CDM\_FIRST + &H5)
Const CDM\_SETDEFEXT = (CDM\_FIRST + &H6)
Const SM\_CXDLGFRAME = 7
Const SM\_CYDLGFRAME = 8
Const SM\_CYCAPTION = 4
Const MAX\_PATH = 260
Public Enum CdlFlags
OFN\_ALLOWMULTISELECT = &H200
OFN\_CREATEPROMPT = &H2000
OFN\_ENABLEHOOK = &H20
OFN\_ENABLETEMPLATE = &H40
OFN\_ENABLETEMPLATEHANDLE = &H80
OFN\_EXPLORER = &H80000
OFN\_EXTENSIONDIFFERENT = &H400
OFN\_FILEMUSTEXIST = &H1000
OFN\_HIDEREADONLY = &H4
OFN\_LONGNAMES = &H200000
OFN\_NOCHANGEDIR = &H8
OFN\_NODEREFERENCELINKS = &H100000
OFN\_NOLONGNAMES = &H40000
OFN\_NONETWORKBUTTON = &H20000
OFN\_NOREADONLYRETURN = &H8000
OFN\_NOTESTFILECREATE = &H10000
OFN\_NOVALIDATE = &H100
OFN\_OVERWRITEPROMPT = &H2
OFN\_PATHMUSTEXIST = &H800
OFN\_READONLY = &H1
OFN\_SHAREAWARE = &H4000
OFN\_SHAREFALLTHROUGH = 2
OFN\_SHARENOWARN = 1
OFN\_SHAREWARN = 0
OFN\_SHOWHELP = &H10
End Enum
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type NMHDR
hwndFrom As Long
IDfrom As Long
Code As Long
End Type
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function PathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" (ByVal pszPath As String) As Long
Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SendMessageString Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOFN As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOFN As OPENFILENAME) As Long
Private m\_fOpenFlags As CdlFlags
Private m\_fSaveFlags As CdlFlags
Private m\_sOpenFilter As String
Private m\_sSaveFilter As String
Private m\_lOpenMaxFileLen As Long
Private m\_lSaveMaxFileLen As Long
Private m\_sOpenDialogTitle As String
Private m\_sSaveDialogTitle As String
Private m\_sOpenInitialDir As String
Private m\_sSaveInitialDir As String
Private m\_cControl As Control
Private m\_cControl1 As Control
Public Event FileChanged(ByVal FileName As String)
Public Event FolderChanged(ByVal Path As String)
Public Event DialogInitialized()
Public Event DialogClosed()
Public Event PressedOKButton()
Property Get ControlToSetNewParent() As Control
Set ControlToSetNewParent = m\_cControl
End Property
Property Let ControlToSetNewParent(cNew As Control)
Set m\_cControl = cNew
End Property
Property Get ControlToSetNewParent1() As Control
Set ControlToSetNewParent1 = m\_cControl1
End Property
Property Let ControlToSetNewParent1(cNew As Control)
Set m\_cControl1 = cNew
End Property
Property Get OpenFlags() As CdlFlags
OpenFlags = m\_fOpenFlags
End Property
Property Let OpenFlags(fNew As CdlFlags)
m\_fOpenFlags = fNew
End Property
Property Get OpenFilter() As String
OpenFilter = m\_sOpenFilter
End Property
Property Let OpenFilter(sNew As String)
m\_sOpenFilter = sNew
End Property
Property Get OpenDialogTitle() As String
OpenDialogTitle = m\_sOpenDialogTitle
End Property
Property Let OpenDialogTitle(sNew As String)
m\_sOpenDialogTitle = sNew
End Property
Property Get OpenInitialDir() As String
OpenInitialDir = m\_sOpenInitialDir
End Property
Property Let OpenInitialDir(sNew As String)
m\_sOpenInitialDir = sNew
End Property
Property Get OpenMaxFileLen() As String
OpenMaxFileLen = m\_lOpenMaxFileLen
End Property
Property Let OpenMaxFileLen(lNew As String)
m\_lOpenMaxFileLen = lNew
End Property
Property Get SaveInitialDir() As String
SaveInitialDir = m\_sSaveInitialDir
End Property
Property Let SaveInitialDir(sNew As String)
m\_sSaveInitialDir = sNew
End Property
Property Get SaveFlags() As CdlFlags
SaveFlags = m\_fSaveFlags
End Property
Property Let SaveFlags(fNew As CdlFlags)
m\_fSaveFlags = fNew
End Property
Property Get SaveFilter() As String
SaveFilter = m\_sSaveFilter
End Property
Property Let SaveFilter(sNew As String)
m\_sSaveFilter = sNew
End Property
Property Get SaveDialogTitle() As String
SaveDialogTitle = m\_sSaveDialogTitle
End Property
Property Let SaveDialogTitle(sNew As String)
m\_sSaveDialogTitle = sNew
End Property
Property Get SaveMaxFileLen() As String
SaveMaxFileLen = m\_lSaveMaxFileLen
End Property
Property Let SaveMaxFileLen(lNew As String)
m\_lSaveMaxFileLen = lNew
End Property
Public Function ShowOpen(ByVal hwndOwner As Long) As String
Dim sBuf As String
Dim r As Long
Dim OFN As OPENFILENAME
sBuf = String(m\_lOpenMaxFileLen, 0)
If (m\_fOpenFlags And OFN\_ENABLEHOOK) OFN\_ENABLEHOOK Then
m\_fOpenFlags = m\_fOpenFlags + OFN\_ENABLEHOOK
End If
With OFN
.lStructSize = Len(OFN)
.flags = m\_fOpenFlags
.hInstance = App.hInstance
.hwndOwner = hwndOwner
.lpfnHook = addr(AddressOf ComDlgCallback)
.lpstrFile = sBuf
.lpstrFilter = Replace(m\_sOpenFilter, "|", vbNullChar)
.lpstrInitialDir = m\_sOpenInitialDir
.lpstrTitle = m\_sOpenDialogTitle
.nFilterIndex = 1
.nMaxFile = Len(sBuf)
r = GetOpenFileName(OFN)
If r 0 Then
ShowOpen = Left(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
End If
End With
End Function
Public Function ShowSave(ByVal hwndOwner As Long) As String
Dim sBuf As String
Dim r As Long
Dim OFN As OPENFILENAME
sBuf = String(m\_lSaveMaxFileLen, 0)
If (m\_fSaveFlags And OFN\_ENABLEHOOK) OFN\_ENABLEHOOK Then
m\_fSaveFlags = m\_fSaveFlags + OFN\_ENABLEHOOK
End If
With OFN
.lStructSize = Len(OFN)
.flags = m\_fSaveFlags
.hInstance = App.hInstance
.hwndOwner = hwndOwner
.lpfnHook = addr(AddressOf ComDlgCallback)
.lpstrFile = sBuf
.lpstrFilter = Replace(m\_sSaveFilter, "|", vbNullChar)
.lpstrInitialDir = m\_sSaveInitialDir
.lpstrTitle = m\_sSaveDialogTitle
.nFilterIndex = 1
.nMaxFile = Len(sBuf)
r = GetSaveFileName(OFN)
If r 0 Then
ShowSave = Left(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
End If
End With
End Function
Public Sub pIncomingMessage(ByVal hWndDlg As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
Dim tNMH As NMHDR
Dim tR As RECT
Dim lBorderSize As Long
Dim lCaptionSize As Long
Dim scHeight As Long
Dim scWidth As Long
Dim s As String
Static OldhWnd As Long
Static OldhWnd1 As Long
Select Case Msg
Case WM\_INITDIALOG
If Not m\_cControl Is Nothing Then
m\_cControl.Visible = True
m\_cControl1.Visible = True
OldhWnd = GetParent(m\_cControl.hWnd)
OldhWnd1 = GetParent(m\_cControl1.hWnd)
lBorderSize = GetSystemMetrics(SM\_CXDLGFRAME)
lCaptionSize = GetSystemMetrics(SM\_CYCAPTION)
SetParent m\_cControl.hWnd, GetParent(hWndDlg)
SetParent m\_cControl1.hWnd, GetParent(hWndDlg)
GetWindowRect GetParent(hWndDlg), tR
scHeight = Screen.Height / Screen.TwipsPerPixelY
scWidth = Screen.Width / Screen.TwipsPerPixelX
MoveWindow GetParent(hWndDlg), tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top + m\_cControl.Height \ Screen.TwipsPerPixelY - 10 - lBorderSize \* 2, 1
MoveWindow m\_cControl.hWnd, 8, tR.Bottom - tR.Top - lCaptionSize - GetSystemMetrics(SM\_CYDLGFRAME) \* 2 - 10 - 20, 57, m\_cControl.Height \ Screen.TwipsPerPixelY, 1
MoveWindow m\_cControl1.hWnd, 80, tR.Bottom - tR.Top - lCaptionSize - GetSystemMetrics(SM\_CYDLGFRAME) \* 2 - 10 - 20, tR.Right - tR.Left - lBorderSize \* 2 - 90, m\_cControl.Height \ Screen.TwipsPerPixelY, 1
End If
RaiseEvent DialogInitialized
Case WM\_NOTIFY
CopyMemory tNMH, ByVal lParam, Len(tNMH)
Select Case tNMH.Code
Case CDN\_SELCHANGE
s = GetDlgPath(CDM\_GETFILEPATH, hWndDlg)
If PathIsDirectory(s) = False And \_
CBool(PathFileExists(s)) Then \_
RaiseEvent FileChanged(s)
Case CDN\_FOLDERCHANGE
RaiseEvent FolderChanged(GetDlgPath(CDM\_GETFOLDERPATH, \_
hWndDlg))
Case CDN\_FILEOK
RaiseEvent PressedOKButton
Case CDN\_TYPECHANGE
End Select
Case WM\_DESTROY
If Not m\_cControl Is Nothing Then
SetParent m\_cControl.hWnd, OldhWnd
SetParent m\_cControl1.hWnd, OldhWnd
m\_cControl.Visible = False
m\_cControl1.Visible = False
End If
RaiseEvent DialogClosed
End Select
End Sub
Private Function addr(ByVal a As Long) As Long
addr = a
End Function
Private Function GetDlgPath(ByVal lConst As Long, hWndDlg As Long) As String
Dim sBuf As String
Dim lPos As Long
Dim hWnd As Long
hWnd = GetParent(hWndDlg)
sBuf = String(MAX\_PATH, 0)
SendMessageString hWnd, lConst, MAX\_PATH, sBuf
lPos = InStr(1, sBuf, vbNullChar)
If lPos \> 0 Then
GetDlgPath = Left(sBuf, lPos - 1)
Else
GetDlgPath = sBuf
End If
End Function
Private Sub Class\_Initialize()
m\_fOpenFlags = OFN\_EXPLORER + OFN\_ENABLEHOOK + OFN\_PATHMUSTEXIST + OFN\_HIDEREADONLY + OFN\_FILEMUSTEXIST
m\_fSaveFlags = OFN\_EXPLORER + OFN\_ENABLEHOOK + OFN\_HIDEREADONLY + OFN\_OVERWRITEPROMPT + OFN\_PATHMUSTEXIST
m\_sOpenFilter = "Alle Dateien (\*.\*)|\*.\*"
m\_sSaveFilter = "Alle Dateien (\*.\*)|\*.\*"
m\_lOpenMaxFileLen = MAX\_PATH
m\_lSaveMaxFileLen = MAX\_PATH
End Sub
'Code im Modul
Public ccClass As cCommonDialog
Public Function ComDlgCallback(ByVal hWndDlg As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Not ccClass Is Nothing Then ccClass.pIncomingMessage hWndDlg, Msg, wParam, lParam
End Function
'Code in der Form
Private WithEvents ÖffnenSpeichern As cCommonDialog
Private Sub OpenSave(vData As Boolean)
Dim sFile As String
Set ÖffnenSpeichern = New cCommonDialog
Set ccClass = ÖffnenSpeichern ' Nicht vergessen!
With ÖffnenSpeichern
.ControlToSetNewParent = Temp.Picture1
.ControlToSetNewParent1 = Temp.Text1
If vData Then
sFile = .ShowSave(Me.hWnd)
Else
sFile = .ShowOpen(Me.hWnd)
End If
End With
Msgbox "File: " & sFile & vbnewline & "Password: " & Text1.Text
End Sub
Natürlich werden auch folgende Ereignise ausgelöst 
Closed
Initialized
FileChange
FolderChange
PressedOkButton
Damit nun auch alles klappt, so legt einfach auf die Form eine Textbox mit den Namen Text1 eine Picturebox mit den Namen Picture1. Darin sollte dann ein Label enthalten sein, mit der Caption Password:
Die Eigenschaft Passwordchar der Textbox sollte auf * gesetzt sein
Die Eigenschaften Height von Text1 und Picture1 sollten auch identisch sein genauso sollten die Eigenschaften Visible auf False gesetz sein
MfG Alex