| |
▼ようたん さん：
おはようございます。
確認はしていませんが
（いや、作成した時には何度も確認したはずですが、投稿前にはしてない）、
以下のコードで作動すると思います。
「Microsoft Jet and Replication Objects 2.6 Library」に参照設定を行います。
標準モジュールに
'=========================================================
Sub test()
Dim ret As Long
ret = chg_pass_mdb("D:\My Documents\db1.mdb", "db1", "db1")
If ret = 0 Then
MsgBox "ok"
Else
MsgBox Error(ret)
End If
End Sub
'======================================
Function chg_pass_mdb(ByVal dbpath, o_pdw, n_pdw, Optional tmpstr = "tmp.mdw") As Long
' 機能 指定されたMDBファイルの最適化及び、パスワード変更を行う
' ＩＮ dbpath 最適化及び、パスワード変更を行うMDBファイルのフルネーム
' o_pdw 変更前のパスワード パスワードが元々ない場合は o_pdw=""とする
' n_pdw 変更後のパスワード パスワードなしの場合は、 n_pdw=""とする
' tmpstr 省略可能 最適化及び、パスワード変更処理に使われるテンポファイル名
' 指定されたMDBファイルdbpathと同じフォルダ上に一時的に作成される
'
' ＯＵＴ chg_pass_mdb 0--正常終了 その他----異常終了
On Error Resume Next
Dim je As JRO.JetEngine
Dim getmypath As String
chg_pass_mdb = 0
getmypath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(dbpath)
If Dir(getmypath & "\" & tmpstr) <> "" Then
Kill getmypath & "\" & tmpstr
If Err.Number <> 0 Then
chg_pass_mdb = Err.Number
Exit Function
End If
End If
Set je = New JRO.JetEngine
je.CompactDatabase "Data Source=" & dbpath & ";Jet OLEDB:Database Password=" & o_pdw, _
"Data Source=" & getmypath & "\" & tmpstr & ";" & _
"Jet OLEDB:Database Password=" & n_pdw
If Err.Number <> 0 Then
chg_pass_mdb = Err.Number
Else
Kill dbpath
Name getmypath & "\" & tmpstr As dbpath
End If
Set je = Nothing
End Function
試してみてください。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
