楽しい情報満載だぜ(ﾟ▽ﾟ*)ﾆﾊﾟｯ♪

嘘です。(ﾟ▽ﾟ*)ﾆﾊﾟｯ♪

ADO と ADOX オブジェクトの Propertiesコレクション

ADO と ADOX オブジェクトの Propertiesコレクション
http://msdn.microsoft.com/ja-jp/library/dd263027.aspx

access2007:分割フォームコントロール区別

分割フォーム上でデータシート側/フォーム側でのコントロール区別
Form.CurrentView プロパティ
Me.CurrentView = 1 フォームビュー
Me.CurrentView = 2 データシートビュー

更新できないRecordset

tblPuroduct,tblCategoryでjoinしたRecordsetは更新ができない。
SELECT tblPuroduct.*, tblCategory.CategoryName
FROM tblPuroduct
LEFT JOIN tblCategory USING (CategoryID);
USINGとは** ON tblPuroduct.CategoryID = tblCategory.CategoryID
ODBC接続しているのであるが、おそらく制約で更新できるRecordsetにならない。
ADO動的プロパティを使ってみてもうまくいった試しがないから、別の手段で。

手段1
リンクテーブルとフォームプロパティUniqueTable使用
手段2
joinで結合するFieldを読み取り専用にしちゃう
SELECT tblPuroduct.*, IFNULL(tblCategory.CategoryName,'')
FROM tblPuroduct
LEFT JOIN tblCategory ON USING (CategoryID);

MySQL:Insert Update Trigger

schema:testに親テーブルp01と子テーブルc01
p01.childrowsにc01のレコード数が入るイメージで、
insert,update時にtirggerを回す
***** p01 *****
CREATE TABLE `test`.`p01` (
`ID` int(11) NOT NULL AUTO_INCREMENT,
`name` varchar(45) NOT NULL,
`childrows` int(11) DEFAULT '0',
PRIMARY KEY (`ID`)
) ENGINE=InnoDB AUTO_INCREMENT=6 DEFAULT CHARSET=cp932;

***** c01 *****
CREATE TABLE `test`.`c01` (
`ID` int(10) unsigned NOT NULL AUTO_INCREMENT,
`Chilldname` varchar(10) NOT NULL,
`pID` int(11) DEFAULT NULL,
`isDeleted` int(1) DEFAULT '0',
PRIMARY KEY (`ID`)
) ENGINE=InnoDB AUTO_INCREMENT=11 DEFAULT CHARSET=cp932;

***** inset_trigger *****
delimiter //
create trigger c01_after_insert
after insert on test.c01
for each row
begin
update p01
set childrows = (select count(*) from c01 where pID = new.pID and c01.isDeleted = 0)
where ID = new.pID;
end//
delimiter ;

***** update trigger *****
delimiter //
create trigger c01_after_update
after update on test.c01
for each row
begin
if new.isDeleted <> old.isDeleted then
update p01
set childrows = (select count(*) from c01 where pID = new.pID and c01.isDeleted = 0)
where ID = new.pID;
end if;
end//
delimiter ;

access2007:パスワードロックしたaccdbからリンクテーブル作成

MSDNlibraryみたんだけどエラー出るから直した

Sub CreateLinkedAccessTable(strDBLinkFrom As String, _
                            strDBLinkTo As String, _
                            strLinkTbl As String, _
                            strLinkTblAs As String, _
                            Pswd As String)

Dim catDB As ADOX.Catalog
Dim tblLink As ADOX.Table

 Set catDB = New ADOX.Catalog
 catDB.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                          "Data Source=" & strDBLinkTo & _
                          ";Jet OLEDB:Database Password=" & Pswd & ";"

 Set tblLink = New ADOX.Table
 With tblLink
  .Name = strLinkTblAs
  Set .ParentCatalog = catDB
      .Properties("Jet OLEDB:Create Link") = True
      .Properties("Jet OLEDB:Link Datasource") = strDBLinkFrom
      .Properties("Jet OLEDB:Remote Table Name") = strLinkTbl
      .Properties("Jet OLEDB:Link Provider String") = ";pwd=" & Pswd
  End With

 catDB.Tables.Append tblLink

 Set catDB = Nothing
End Sub

access2007:パスワードロックしたaccdbのテーブル列挙

Sub ListAccessTables()
Dim catDB As ADOX.Catalog
Dim tblList As ADOX.Table
Dim dbDir As String, Pswd As String

    dbDir = "\\hogehoge\hogehoge.accdb"
    Pswd = "Passw0rd"

    Set catDB = New ADOX.Catalog

    catDB.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                             "Data Source=" & dbDir & ";" & _
                             "Jet OLEDB:Database Password=" & Pswd & ";"

    For Each tblList In catDB.Tables
        If tblList.Type = "TABLE" Then
            Debug.Print tblList.Name & vbTab & tblList.Type
        End If
    Next
    Set catDB = Nothing
End Sub

access2007:パスワードロックしたaccdbへのアクセス

Dim cn As New ADODB.Connection
Dim cnStr As String, dbDir As String, Pswd As String

    dbDir = "\\hogehoge\database\hogeDB.accdb"
    Pswd = "Passw0rd"
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & dbDir & ";" & _
            "Jet OLEDB:Database Password=" & Pswd & ";"
    cn.Open cnStr

http://www.connectionstrings.com/
ここは有益だ

ADO：CSV読み込み

ADOを使用した、CSV→recordset
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strFolder As String, cnStr As String
Dim fileName As String, selectSQL As String

cnStr = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq="
strFolder = "C:\hogehoge"
fileName = "hogehoge.csv"
selectSQL = "SELECT * FROM " & fileName

cn.Open cnStr & strFolder
rs.Open selectSQL, cn, adOpenKeyset, adLockReadOnly

Do Until rs.EOF
　　**お好みのupdate処理**
rs.MoveNext
Loop

rs.Close: cn.Close
Set rs = Nothing: Set cn = Nothing

ヘッダがないなら、Jetです。
cnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
strFolder = "C:\hogehoge;"
exProp = "Extended Properties=""text;HDR=No;FMT=Delimited;"";"
cn.Open cnStr & strFolder & exProp

mySQL-Win-x64

win2008SVstdいじくり倒し用サーバにmySQL5を導入してみた。
インストール自体は無事に済んだが、セットアップウィザードが完了しない。
administratorでログインしたら成功した。

access2007:分割フォーム

分割フォーム上でDirty時のみ押下できるButtonControl(更新ボタン)を配置した場合
分割フォーム側で操作した時はRequeryしてやらないと反映されない。

Private Sub Form_Undo(Cancel As Integer)
Me.btnUpdate.Enabled = False
Me.btnUpdate.Requery
End Sub

Private Sub Form_Current()
Me.btnUpdate.Enabled = False
Me.btnUpdate.Requery
End Sub

Private Sub Form_Dirty(Cancel As Integer)
Me.btnUpdate.Enabled = True
Me.btnUpdate.Requery
End Sub

access2007:UniqueTableプロパティ

非連結フォーム+ADO接続で、Inner Joinで複数のテーブルを連結している場合、UniqueTableプロパティを指定すると更新ができるようになる。削除追加はできるけどやらない。
Unique側更新だけにとどめる。
Private Sub Form_Open(Cancel As Integer)
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim selectSQL As String, fld As ADODB.Field

selectSQL = "SELECT tblProducts.sID, tblProducts.商品名, tblCategories.CategoryID, tblCategories.Category FROM tblCategories INNER JOIN tblProducts ON tblCategories.CategoryID=tblProducts.ｃID;"

Set cn = Application.CurrentProject.Connection

rs.CursorLocation = adUseClient
rs.Open selectSQL, cn, adOpenKeyset, adLockOptimistic

Set Me.Recordset = rs
Me.UniqueTable = "tblProducts"
For Each fld In rs.Fields
　　Me.Controls(fld.Name).ControlSource = fld.Name
Next

Set rs = Nothing: Set cn = Nothing
End Sub
Unique側については、Form_Errorで7787、30014を使える

access2007 フォーム設定:NavigationButtons

デザインビューでの設定とVBAでの設定では挙動が違う場合があった。
移動ボタン:いいえ
　ボタンは消えるが領域が消えない
Me.NavigationButtons = False
　領域ごと消える

非連結フォームによる更新ADO

多少制限があるものの一応動作する。
コマンドでのレコード移動時にrs.Updateしていないが、
フォームが編集モードにある場合での移動は更新されている。
データ競合の場合は、rs.Resyncで最新状態を取得
Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
rsSet
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection

Set rs = Me.Recordset
Set cn = Me.Recordset.ActiveConnection
rs.Close: cn.Close
Set rs = Nothing: Set cn = Nothing
End Sub

Private Sub コマンド0_Click() '閉じる
DoCmd.SetWarnings False'クリップボードに保存するか？とか聞いてくるので付けてみた
DoCmd.Close
DoCmd.SetWarnings True
End Sub

Private Sub rsSet()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim selectSQL As String

selectSQL = "SQLString"
cn.Open = "ConnectionString
rs.CursorLocation = adUseClient
rs.Open selectSQL, cn, adOpenKeyset, adLockOptimistic

Set Me.Recordset = rs
'コントロールのControlSourceは、プロパティで指定済み

Set rs = Nothing: Set cn = Nothing
End Sub

Private Sub コマンド20_Click() '前へ
On Error GoTo err_hnd
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
If Not Me.CurrentRecord = 1 Then
　rs.MovePrevious
Else
　rs.MoveLast
End If
Set rs = Nothing
Exit Sub
err_hnd:
rsResync
End Sub

Private Sub コマンド21_Click() '次へ
On Error GoTo err_hnd
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
If Me.CurrentRecord = Me.Recordset.RecordCount Then
　rs.MoveFirst
Else
　rs.MoveNext
End If
Set rs = Nothing
Exit Sub
err_hnd:
rsResync
End Sub

Private Sub コマンド22_Click() '保存
On Error GoTo err_hnd
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
rs.Update
Me.Refresh
Set rs = Nothing
Exit Sub
err_hnd:
rsResync
End Sub

Private Sub rsResync()
On Error Resume Next
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
Me.Undo
rs.Resync
Me.Refresh
End Sub

非連結レポート

Form1でフィルターとソートしてあるRecordSetを印刷する
として、Cloneをレポートで使用。詳細セクションに配置した
コントロール名とRecordSet.Field名は同一とする。

Dim rs As New ADODB.Recordset
Private Sub Report_Open(Cancel As Integer)
Set rs = Forms("Form1").RecordsetClone
rs.Filter = Forms("Form1").Recordset.Filter
rs.Sort = Forms("Form1").Recordset.Sort
End Sub
Private Sub レポートヘッダー_Format(Cancel As Integer, FormatCount As Integer)
rs.MoveFirst　’印刷プレビューするなら先頭移動が必要
End Sub
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
Dim Ctr As Control
For Each Ctr In Me.詳細.Controls
Ctr = rs(Ctr.Name)
Next
rs.MoveNext
If Not rs.EOF Then Me.NextRecord = False
End Sub
Private Sub Report_Unload(Cancel As Integer)
rs.Close: Set rs = Nothing
End Sub

非連結フォームによる更新削除

[前提条件]
テーブルのフィールド名とフォームのフィールド名が一致
Option Compare Database
Option Explicit
Const cnStr = "接続文字列"

Private Sub Form_BeforeUpdate(Cancel As Integer)'更新確認
If MsgBox("更新しますか？", vbOKCancel) = vbCancel Then Cancel = True: Me.Undo
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
'データの競合ポップアップ抑制
If DataErr = 7787 Then
MsgBox "データが競合しています。"
Response = acDataErrContinue
End If
End Sub

Private Sub Form_Open(Cancel As Integer)
Call rsreSet
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
Set cn = Me.Recordset.ActiveConnection
Set rs = Me.Recordset
rs.Close
cn.Close
Set cn = Nothing: Set rs = Nothing
End Sub

Private Sub rsreSet()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
cn.Open cnStr
rs.CursorLocation = adUseClient
rs.Open "SQL文字列", cn, adOpenKeyset, adLockOptimistic
Set Me.Recordset = rs'フィールド名が一致している
Set cn = Nothing
Set rs = Nothing
End Sub

Private Sub コマンド15_Click()'次へ
On Error Resume Next
DoCmd.RunCommand acCmdRecordsGoToNext
End Sub

Private Sub コマンド16_Click()'前へ
On Error Resume Next
DoCmd.RunCommand acCmdRecordsGoToPrevious
End Sub

Private Sub コマンド17_Click()'移動せず更新
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub コマンド22_Click()'削除
On Error Resume Next
DoCmd.RunCommand acCmdDeleteRecord
End Sub

Private Sub コマンド23_Click()'recordset更新
rsreSet
End Sub

Microsoft Access Developer Extensions 2007 (ADE 2007)つづき

いろいろ試してわかったことがある。
インストール先フォルダの指定の仕様なのかな？
http://support.microsoft.com/kb/937999/ja
機械翻訳よくわからんです。読んだ限りでは不具合っぽいな。

インストールフォルダをすべてのユーザ系
・システムドライブ(すべてのユーザ)
・共通のAppData(すべてのユーザ、Vistaでは読み取り専用)
・Program Files(すべてのユーザ、Vistaでは読み取り専用)
が選択できる。
システムドライブを指定した場合、
起動すると読み取り専用として起動するのでアラート出現

現在のrecordsetは更新をサポートしていません。。。。。

OK押下すると、
読み取り専用　このデータベースは読み取り専用で開いています。。。。。
で、
権限のあるMyDocumentとかに保存すると、
セキュリティに関する通知が出て、承認すると起動できる。
毎回発生するから、これを避けたい感じ。

調べてみた。
ルートインストールフォルダをシステムドライブとした場合、
C:\sample とかになるが、このフォルダのセキュリティは、
Usersが変更書き込みの権限がない。adminで権限を追加すれば、期待した通りの作動が可能だ。とりあえず。

・ユーザーのAppData(現在のユーザー)
・マイドキュメント(現在のユーザー)
・デスクトップ(現在のユーザー)
デスクトップにインストールはないとして、上二つであれば特段問題なく起動する模様。
ユーザごとにインストールしなければならないこととユーザー権限でインストール＆アンインストールできることになるのか？

別件、accdeをパッケージしても、インストール先では、accdrになるのね。
accdbに変更してもVBAは見れないからコンパイルされた状態に変わりはない感じ。

Microsoft Access Developer Extensions 2007 (ADE 2007)

とても便利だ。
なによりもセキュリティ関連の設定も済ましてくれるから、警告が出ないようになる。

accessベースのアプリ配布に使うべし。
・accdeへの変更
VBAコードはコンパイルされるため参照変更ができなくなる

・パスワードによる暗号化
知らなければアプリが起動しないし、外部からのリンクも同様に制限できる

Bootable USBメモリ/VISTA～

Win Vista/7
USBメモリを必要に応じてフォーマット
　↓
ディスクの管理でプライマリパーティション、アクティブ
　↓
ISOイメージ内のすべてをコピーして

E:\Boot\Bootsect /nt60 E:
E:はUSBメモリのドライブレター

date_format関数

accessフォームのリストボックスに日付フィールドを表示。
狭いので日付表示ｙｙｙｙ/ｍｍ/ｄｄを変更する。

そのままであれば、
select sampledate from TableName;
で呼び出して、
set me.listbox_0.RecordSet = Rs
で問題なし。

mm/ddに変更するため、mySQLの関数を利用。
select date_format(sampledate,'%m/%d') from TableName;
これは残念な結果になる　'バイナリ'

さらにmySQLの関数を利用。convert(xxxx ujing CharSet)
select convert(date_format(sampledate,'%m/%d') using sjis) from TableName;

楽観的

トランザクションとか抜きに楽観的に考えた。mySQLのTimeStampを利用。
分解能は1秒だから秒単位に同時更新するとどうなるかわからない。
たぶん、後だしが勝つのではないかと。

日時処理は、帳票見ながらのinsertと誤投入のUpdateなのだからさ。

更新したレコード数を取得(ADO Command)

RecordSetを返さないコマンド（アクションクエリやストアドプロシージャ)の場合

command.Execute RecordsAffected

プロバイダがLongで返してくれる。

RecordSetを返すクエリなどについては、RecordCountで。

**********************************
Dim cn As New ADODB.Connection
Dim updateSQL As String
Dim ra As Long

updateSQL = "update TableName set column1 = '2009/1/1' where ID =1 and UpdateTime = '2009/1/1 00:00:00';"

cn.Open [ConnectionString]
cn.Execute updateSQL, ra
If ra = 0 Then MsgBox "更新されませんでした。", vbCritical

cn.Close:Set cn = Nothing