access2010 パラメータクエリを使ったフォームを開く

フォームのコントロールソースを、

PARAMETERS param01 Long;
SELECT table01.ID, table01.F01
FROM table01
WHERE (((table01.F01)>[param01]));

こんな感じにして、

<?xml version="1.0" encoding="UTF-16" standalone="no"?>
<UserInterfaceMacros xmlns="http://schemas.microsoft.com/office/accessservices/2009/11/application">
  <UserInterfaceMacro MinimumClientDesignVersion="14.0.0000.0000">
    <Statements>
      <Action Name="OpenForm">
        <Argument Name="FormName">form01</Argument>
        <Parameters>
          <Parameter Name="param01" Value="5"/>
        </Parameters>
      </Action>
    </Statements>
  </UserInterfaceMacro>
</UserInterfaceMacros>

<?xml version="1.0" encoding="UTF-16" standalone="no"?>
<UserInterfaceMacros xmlns="http://schemas.microsoft.com/office/accessservices/2009/11/application">
  <UserInterfaceMacro MinimumClientDesignVersion="14.0.0000.0000">
    <Statements>
      <Action Name="OpenForm">
        <Argument Name="FormName">form01</Argument>
        <Argument Name="View">Datasheet</Argument>
        <Parameters>
          <Parameter Name="param01" Value="5"/>
        </Parameters>
      </Action>
    </Statements>
  </UserInterfaceMacro>
</UserInterfaceMacros>

各々のマクロでフォームを開き、すべて更新を実行したとする。
フォームビューの場合、パラメータ値が適用され期待通りに更新できるのだが、データシートビューの場合、再度パラメータ値の問い合わせが発生する。パラメータを投入すると更新はされる。
パラメータ投入をキャンセル後再度すべての更新を実行すると、

 こんなことになると。
パラメータクエリをさっくり便利に使える機能だけにもったいないなと思うばかり。なぜデータシートビューだけこうなってしまうのだろうか。
分割フォームだとデータシートを上か左と下か右にした場合挙動がちょっと変わるけど、さらにダメな子になっちゃうね。

んと、不具合だそうです。そうだよねやっぱり。

対策1
データシートビューのフォームでは使用しない

対策2
レコードソースのWhere句にTempVarsコレクションを使用する。

access2010 access2007 複数値を持つコンボボックス -1-

複数値を持つコンボボックスに値設定
ポイントは、未選択の時はNull、選択されている状態の時はVariant配列ということ。

access2010 DoCmd.SetFilter/DoCmd.SetOrderBy

地味だけど、access2010で追加されたDoCmdオブジェクトのメソッド。
ちょっとコードがすっきりするのと、サブフォーム/サブレポートに対する実行が便利なくらい。
あとは、フィルター設定時/フィルター実行時イベントを使えるようになる。使ったことないけど。

access2010 データサービス その3

できました。

もうね、できてしまうとなーんだって感じなのだけれども。
途中でSharepointリストを作成しているけど、これは外部コンテンツへの接続を試しているだけだからなくてもいいはず。

今回のテストではSQLServerへの接続を試みていて、SQLServerならaccessから直接見に行けばいいじゃんってことはあるけど、Sharepointを経由する意味はある。

access2010 access2007 GUID取得

以前から使ってたのはちょっとなんだから、見直し。
accessに StringFromGUIDってのがあるから使ってみる。
ふむふむ、StringFromGUIDの引数はByte配列だと。でこうなった。

Option Compare Database
Option Explicit

Private Type GUID
    GUIDData(0 To 15) As Byte
End Type

#If VBA7 Then
Private Declare PtrSafe Function CoCreateGuid Lib "ole32" ( _
                                pGUID As GUID _
                                ) As Long

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
                                Alias "RtlMoveMemory" ( _
                                Destination As Any, _
                                Source As Any, _
                                ByVal Length As LongPtr)
#Else
Private Declare Function CoCreateGuid Lib "ole32" ( _
                                pGUID As GUID _
                                ) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" _
                                Alias "RtlMoveMemory" ( _
                                Destination As Any, _
                                Source As Any, _
                                ByVal Length As Long)
#End If

Function GetNewGUID() As String
    Dim tmpGUID As GUID, tmpData(0 To 15) As Byte
    If CoCreateGuid(tmpGUID) = 0 Then
        CopyMemory tmpData(0), tmpGUID.GUIDData(0), 16
        GetNewGUID = Mid(StringFromGUID(tmpData), 7, 38)
    End If
End Function

これで速度はおよそ5倍になった。概ね満足。
いっそのことCopyMemoryも無くしちゃえばいいんじゃね？
と、なってさらにこうなった。

Option Compare Database
Option Explicit
                                
#If VBA7 Then
Private Declare PtrSafe Function CoCreateGuid Lib "ole32" ( _
                                ByVal pGUID As LongPtr _
                                ) As Long
#Else
Private Declare Function CoCreateGuid Lib "ole32" ( _
                                ByVal pGUID As Long _
                                ) As Long
#End If

Function GetNewGUID() As String
    Dim aryGUID(0 To 15) As Byte
    If CoCreateGuid(VarPtr(aryGUID(0))) = 0 Then
        GetNewGUID = Mid(StringFromGUID(aryGUID), 7, 38)
    End If
End Function

さらに速くなったということはない。

そして、ふと、思った。
何の気なしに、VarPtrとかStrPtrとかLongPtrとか使ってるけど、これって本当に大丈夫なのだろうかと。32bitOS+32bitOfficeは問題なかろうと思うけど。
あえて際を行くことはやらなければよいのだろうな。きっと。

access2010 データサービス その2

access2010 データサービス　の続き。
えいゃっとテクニカルサポートに聞いてみた。
使えるようになるまでの必要なタスクとしては合ってるらしい。
ただ、SharePointが属するAD内のクライアントからの接続でなければ使用できない模様。

ぐぬぬぬ。むきーっ。

ていうと何かい、Office365でAccess Services使えるんだよね。でもって、別途Azureやら外部Webサービスからビジネスデータを取得して使おうと思ったのに使えねぇってのどういうこってぇ！

一応こんな主張で。

access2010 イメージコントロール

access2007からだっけか、イメージコントロールにはコントロールソースプロパティがあるわけで、画像付レポートとか帳票フォームでイメージの取り扱いが簡単になったわけだ。SharedResource(共有イメージ)は、繰り返し使うイメージにつかう。
レポート

帳票フォーム

access2010 データサービス

SharePoint上のBDC（Business Data Connectivity Service）。外部コンテンツをaccess2010でリスト（読み取り専用）として使えるらしいのだけど、その方法が解らない。でも、解らないなりにやってみた。結果としては、うまくいっていない。その失敗までの軌跡。
その後できました。
SharePointに外部コンテンツ（今回はSQL Server）を設置し、access2010にデータサービスをインポートするまで。
スナップショット37点

office2010 Win32API CopyMemory

Option Compare Database
Option Explicit

#If VBA7 Then
Declare PtrSafe Sub CopyMemory Lib "kernel32" _
                                Alias "RtlMoveMemory" ( _
                                Destination As Any, _
                                Source As Any, _
                                ByVal Length As LongPtr)
#Else
Declare Sub CopyMemory Lib "kernel32.dll" _
                                Alias "RtlMoveMemory" ( _
                                Destination As Any, _
                                Source As Any, _
                                ByVal Length As Long)
#End If

access2010 access2007 ADO.Stream SaveToFile

添付ファイル型フィールドに保存されているファイルをローカルに保存する。

#If VBA7 Then
Declare PtrSafe Sub CopyMemory Lib "kernel32" _
                                Alias "RtlMoveMemory" ( _
                                Destination As Any, _
                                Source As Any, _
                                ByVal Length As LongPtr)
#Else
Declare Sub CopyMemory Lib "kernel32" _
                                Alias "RtlMoveMemory" ( _
                                Destination As Any, _
                                Source As Any, _
                                ByVal Length As Long)
#End If

Sub SaveToFileADOStream()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset, strm As New ADODB.Stream
    Dim rs2 As New ADODB.Recordset
    Dim fileBin() As Byte, fileBinSize As Long, bOffset As Long
    Dim fileBin2() As Byte, strSQL As String
    
    strSQL = "Select AttachmentField_Name As FileName " & _
             "From table_Name "
             
'このSQLだと超絶遅い
'    strSQL = "Select AttachmentField_Name.FileName As FileName, " & _
'             "AttachmentField_Name.FileData As FileData " & _
'             "From table_Name"
     
    Set cn = Application.CurrentProject.AccessConnection

    rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly
    Set rs2 = rs(0).Value

    fileBin = rs2.Fields("FileData")
    fileBinSize = UBound(fileBin)
    bOffset = fileBin(0)

    ReDim fileBin2(fileBinSize - bOffset)
    CopyMemory fileBin2(0), fileBin(bOffset), fileBinSize - bOffset

    With strm
        .Open
        .Type = adTypeBinary
        .Write fileBin2
        .SaveToFile CurrentProject.Path & "\" & _
                    rs2("FileName"), adSaveCreateOverWrite
        .Close
    End With

    Set strm = Nothing
    rs2.Close: Set rs2 = Nothing
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End Sub

access2010 access2007 DAO.Fields2 SaveToFile

添付ファイル型フィールドに保存されているファイルをローカルに保存する。

Sub SaveToFileAll()
    Dim strSQL As String, rs As DAO.Recordset
    strSQL = "Select AttachmentField_Name.FileName As FileName, " & _
             "AttachmentField_Name.FileData As FileData " & _
             "From table_Name"
            '"Where FileName = 'FileName'"
 
   Set rs = CurrentDb.OpenRecordset(strSQL)
    
    Do Until rs.EOF
        rs.Fields("FileData").SaveToFile CurrentProject.Path & _
                                     "\" & rs.Fields("FileName").Value
        rs.MoveNext
    Loop
End Sub

Office15ってか

Office 15 Developer Kitchen: Call for Participation
なんだかなぁ
と、いっても、Office2003はすでにメインストリームサポートは終了してるわけで、Office2007が2012年4月に終了と。Office2010は2015年秋のはずだから、XPSP3の延長サポート終了とかOffice2003延長サポート終了あたりやろかね。てか、OSも次のが出ちゃうんじゃね？

別件、
Sascha TrowitzschさんところのmdlOGL0710を64bit実装を試してみた。なんとなくうまくいってるみたいだから、リボンに使うカスタムイメージに使ってみよう。添付ファイルフィールドから直接渡せるようにしてあるのが使いたかっただけなんだけれども。

ついでにわかったこと。
添付ファイルフィールドからADO.Streamのメソッドでファイル出力をしようとするとき、先頭から数バイトオフセットして削ってやればよさそうではないか。どれだけ削るかは先頭を見ろと。access使ってる分にはいらぬ苦労だけど。

そして、ogl.dllとoleaut32.dllっていうのがあること。

office2010 Win32API 条件付きコンパイル WindowFromPoint

#If VBA7 Then
'************** VBA7共通 **************
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

Declare PtrSafe Sub CopyMemory Lib "kernel32" _
                                Alias "RtlMoveMemory" ( _
                                Destination As Any, _
                                Source As Any, _
                                ByVal Length As LongPtr)
'**************************************
    #If Win64 Then
    '************** VBA7x64用 **************
    Declare PtrSafe Function GetWindowLong Lib "user32" _
                                    Alias "GetWindowLongPtrA" ( _
                                    ByVal hwnd As LongPtr, _
                                    ByVal nIndex As Long _
                                    ) As LongPtr
     
    Declare PtrSafe Function SetWindowLong Lib "user32" _
                                    Alias "SetWindowLongPtrA" ( _
                                    ByVal hwnd As LongPtr, _
                                    ByVal nIndex As Long, _
                                    ByVal dwNewLong As LongPtr _
                                    ) As LongPtr
    
    Declare PtrSafe Function GetTickCount64 Lib "kernel32" () As LongLong
      
    Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                    ByVal point As LongLong _
                                    ) As LongPtr
     
    Type POINTAPI
            x As Long
            y As Long
    End Type
     
    Function PointToLongLong(point As POINTAPI) As LongLong
        Dim ll As LongLong
        Dim cbLongLong As LongPtr
         
        cbLongLong = LenB(ll)

        If LenB(point) = cbLongLong Then
            CopyMemory ll, point, cbLongLong
        End If
         
        PointToLongLong = ll
    End Function
    '***************************************
    #Else
    '************** VBA7x86用 **************
    Declare PtrSafe Function GetWindowLong Lib "user32" _
                                    Alias "GetWindowLongA" ( _
                                    ByVal hwnd As LongPtr, _
                                    ByVal nIndex As Long _
                                    ) As LongPtr
     
    Declare PtrSafe Function SetWindowLong Lib "user32" _
                                    Alias "SetWindowLongA" ( _
                                    ByVal hwnd As LongPtr, _
                                    ByVal nIndex As Long, _
                                    ByVal dwNewLong As LongPtr _
                                    ) As LongPtr
     
    Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                    ByVal xPoint As Long, _
                                    ByVal yPoint As Long _
                                    ) As LongPtr
    '***************************************
    #End If
#Else
'************** Office2007以前 **************
Declare Function GetWindowLong Lib "user32" _
                                Alias "GetWindowLongA" ( _
                                ByVal hwnd As Long, _
                                ByVal nIndex As Long _
                                ) As Long
 
Declare Function SetWindowLong Lib "user32" _
                                Alias "SetWindowLongA" ( _
                                ByVal hwnd As Long, _
                                ByVal nIndex As Long, _
                                ByVal dwNewLong As Long _
                                ) As Long
 
Declare Function GetTickCount Lib "kernel32" () As Long
 
Declare Function WindowFromPoint Lib "user32" ( _
                                ByVal xPoint As Long, _
                                ByVal yPoint As Long _
                                ) As Long
#End If

office2010 Win32API GetWindowText/SetWindowText

#If VBA7 Then
Declare PtrSafe Function SetWindowText Lib "user32" _
                                Alias "SetWindowTextW" ( _
                                ByVal Hwnd As LongPtr, _
                                ByVal lpString As LongPtr _
                                ) As Long

Declare PtrSafe Function GetWindowText Lib "user32" _
                                Alias "GetWindowTextW" ( _
                                ByVal Hwnd As LongPtr, _
                                ByVal lpString As LongPtr, _
                                ByVal cch As Long _
                                ) As Long
#Else
Declare Function SetWindowText Lib "user32" _
                                Alias "SetWindowTextW" ( _
                                ByVal hwnd As Long, _
                                ByVal lpString As Long _
                                ) As Long

Declare Function GetWindowText Lib "user32" _
                                Alias "GetWindowTextW" ( _
                                ByVal Hwnd As Long, _
                                ByVal lpString As Long, _
                                ByVal cch As Long _
                                ) As Long
#End If

'textLength = GetWindowText(Hwnd, StrPtr(buffer), Len(buffer))
'成功：終端Null除く文字数 / 失敗：0 / cch超える分は切り捨て

'result = SetWindowText(Hwnd, StrPtr(Strings))
'成功：0 / 失敗：0以外

office2010 Win32API EnumWindows

Option Compare Database
Option Explicit

Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5
Private Const IDOK = &H1
Private Const IDC_EDIT = &H8A5

Private pHwnd As LongPtr
'Type UserDefined01
'    taskID As Long
'    Hwnd As LongPtr
'End Type

Private Declare PtrSafe Function GetWindowText Lib "user32" _
                                Alias "GetWindowTextA" ( _
                                ByVal hwnd As LongPtr, _
                                ByVal lpString As String, _
                                ByVal cch As Long _
                                ) As Long

'http://msdn.microsoft.com/ja-jp/library/cc410851.aspx
Private Declare PtrSafe Function EnumWindows Lib "user32" ( _
                                ByVal lpEnumFunc As LongPtr, _
                                ByVal lParam As Any _
                                ) As Long
'Private Declare PtrSafe Function EnumWindows Lib "user32" ( _
'                                ByVal lpEnumFunc As LongPtr, _
'                                      lParam As Any _
'                                ) As Long

Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" ( _
                                ByVal hwnd As LongPtr, _
                                lpdwProcessId As Long _
                                ) As Long
                                
Private Declare PtrSafe Function GetLastActivePopup Lib "user32" ( _
                                ByVal hwndOwnder As LongPtr _
                                ) As LongPtr
 
Private Declare PtrSafe Function GetDlgItem Lib "user32" ( _
                                ByVal hDlg As LongPtr, _
                                ByVal nIDDlgItem As Long _
                                ) As LongPtr
 
Private Declare PtrSafe Function SendMessage Lib "user32" _
                                Alias "SendMessageA" ( _
                                ByVal hwnd As LongPtr, _
                                ByVal wMsg As Long, _
                                ByVal wParam As LongPtr, _
                                lParam As Any _
                                ) As LongPtr

Private Function ProcIDFromWnd(ByVal hwnd As LongPtr) As Long
    Dim idProc As Long
    GetWindowThreadProcessId hwnd, idProc
    ProcIDFromWnd = idProc
End Function

Private Function GetWinHandleProc(ByVal tmpHwnd As LongPtr, _
                                  ByVal lParam As Long _
                                  ) As Boolean
    If lParam = ProcIDFromWnd(tmpHwnd) Then
        Dim wText As String, wTextLength As Long
        wText = String(255, Chr(0))
        wTextLength = GetWindowText(tmpHwnd, wText, 255)
        If "Microsoft Access" = Left(wText, wTextLength) Then
            pHwnd = tmpHwnd
            GetWinHandleProc = False
            Exit Function
        End If
    End If
    GetWinHandleProc = True
End Function

'Private Function GetWinHandleProc(ByVal tmpHwnd As LongPtr, _
'                                  ByRef lParam As UserDefined01 _
'                                  ) As Boolean
'    If lParam.taskID = ProcIDFromWnd(tmpHwnd) Then
'        Dim wText As String, wTextLength As Long
'        wText = String(255, Chr(0))
'        wTextLength = GetWindowText(tmpHwnd, wText, 255)
'        If "Microsoft Access" = Left(wText, wTextLength) Then
'            lParam.Hwnd = tmpHwnd
'            GetWinHandleProc = False
'            Exit Function
'        End If
'    End If
'    GetWinHandleProc = True
'End Function

Private Function GetWinHandle(taskID As Long) As LongPtr
    pHwnd = 0
    EnumWindows AddressOf GetWinHandleProc, taskID
    GetWinHandle = pHwnd
End Function

'Private Function GetWinHandle(taskID As Long) As LongPtr
'    Dim tmp As UserDefined01
'    tmp.taskID = taskID
'    tmp.Hwnd = 0
'    EnumWindows AddressOf GetWinHandleProc, tmp
'    GetWinHandle = tmp.Hwnd
'End Function

Sub OpenAccdrWithPassword( _
            targetDBFullPath As String, _
            pswd As String, _
            Optional WindowStyle As VbAppWinStyle = vbNormalFocus)
             
    Dim taskID As Long
    Dim targetDBHwnd As LongPtr
    Dim pswdDlgHwnd As LongPtr
    Dim dlgEditHwnd As LongPtr, dlgButtonOKHwnd As LongPtr
     
    If Dir(targetDBFullPath) = "" Then Exit Sub
     
    taskID = Shell("msaccess.exe /runtime " & _
                    targetDBFullPath, _
                    WindowStyle)
    If taskID = 0 Then Exit Sub
 
   'この部分たまたま動作しているのではないか？ 
    targetDBHwnd = GetWinHandle(taskID)
    
    Do
        pswdDlgHwnd = GetLastActivePopup(targetDBHwnd)
    Loop While targetDBHwnd = pswdDlgHwnd
     
    dlgEditHwnd = GetDlgItem(pswdDlgHwnd, IDC_EDIT)
    dlgButtonOKHwnd = GetDlgItem(pswdDlgHwnd, IDOK)
 
    SendMessage dlgEditHwnd, WM_SETTEXT, 0, ByVal pswd
    SendMessage dlgButtonOKHwnd, BM_CLICK, 0, 0
End Sub

office2010 Win32API GetDlgItem/GetLastActivePopup

Option Compare Database
Option Explicit

Private Const GW_HWNDNEXT = &H2
Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5
Private Const IDOK = &H1
Private Const IDCANCEL = &H2
Private Const IDHELP = &H9
Private Const IDC_EDIT = &H8A5 '決め打ち

'http://msdn.microsoft.com/ja-jp/library/cc364779.aspx
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" ( _
                                ByVal hwnd As LongPtr, _
                                lpdwProcessId As Long _
                                ) As Long
'http://msdn.microsoft.com/ja-jp/library/cc364757.aspx
Private Declare PtrSafe Function GetWindow Lib "user32" ( _
                                ByVal hwnd As LongPtr, _
                                ByVal wCmd As Long _
                                ) As LongPtr

'http://msdn.microsoft.com/ja-jp/library/cc364718.aspx
Private Declare PtrSafe Function GetParent Lib "user32" ( _
                                ByVal hwnd As LongPtr _
                                ) As LongPtr

Private Declare PtrSafe Function FindWindow Lib "user32" _
                                Alias "FindWindowA" ( _
                                ByVal lpClassName As String, _
                                ByVal lpWindowName As String _
                                ) As LongPtr

'http://msdn.microsoft.com/ja-jp/library/cc364701.aspx
Private Declare PtrSafe Function GetLastActivePopup Lib "user32" ( _
                                ByVal hwndOwnder As LongPtr _
                                ) As LongPtr

'http://msdn.microsoft.com/ja-jp/library/cc364621.aspx
Private Declare PtrSafe Function GetDlgItem Lib "user32" ( _
                                ByVal hDlg As LongPtr, _
                                ByVal nIDDlgItem As Long _
                                ) As LongPtr

Private Declare PtrSafe Function SendMessage Lib "user32" _
                                Alias "SendMessageA" ( _
                                ByVal hwnd As LongPtr, _
                                ByVal wMsg As Long, _
                                ByVal wParam As LongPtr, _
                                lParam As Any _
                                ) As LongPtr

'http://support.microsoft.com/kb/242308/ja
'EnumWindows
Private Function ProcIDFromWnd(ByVal hwnd As LongPtr) As Long
   Dim idProc As Long
   
   ' Get PID for this HWnd
   GetWindowThreadProcessId hwnd, idProc
   
   ' Return PID
   ProcIDFromWnd = idProc
End Function
      
Private Function GetWinHandle(hInstance As Long) As LongPtr
   Dim tempHwnd As LongPtr
   
   ' Grab the first window handle that Windows finds:
   tempHwnd = FindWindow(vbNullString, vbNullString)
   
   ' Loop until you find a match or there are no more window handles:
   Do Until tempHwnd = 0
      ' Check if no parent for this window
      If GetParent(tempHwnd) = 0 Then
         ' Check for PID match
         If hInstance = ProcIDFromWnd(tempHwnd) Then
            ' Return found handle
            GetWinHandle = tempHwnd
            ' Exit search loop
            Exit Do
         End If
      End If
   
      ' Get the next window handle
      tempHwnd = GetWindow(tempHwnd, GW_HWNDNEXT)
   Loop
End Function

Sub OpenAccdrWithPassword( _
            targetDBFullPath As String, _
            pswd As String, _
            Optional WindowStyle As VbAppWinStyle = vbNormalFocus)
            
    Dim taskID As Long
    Dim targetDBHwnd As LongPtr
    Dim pswdDlgHwnd As LongPtr
    Dim dlgEditHwnd As LongPtr, dlgButtonOKHwnd As LongPtr
    
    If Dir(targetDBFullPath) = "" Then Exit Sub
    
    taskID = Shell("msaccess.exe /runtime " & _
                    targetDBFullPath, _
                    WindowStyle)
    'hInstanceなのか？
    targetDBHwnd = GetWinHandle(taskID)
    
    Do
        pswdDlgHwnd = GetLastActivePopup(targetDBHwnd)
    Loop While targetDBHwnd = pswdDlgHwnd
    
    dlgEditHwnd = GetDlgItem(pswdDlgHwnd, IDC_EDIT)
    dlgButtonOKHwnd = GetDlgItem(pswdDlgHwnd, IDOK)

    SendMessage dlgEditHwnd, WM_SETTEXT, 0, ByVal pswd
    SendMessage dlgButtonOKHwnd, BM_CLICK, 0, 0
End Sub