VBA SQL – Just another WordPress site

2023年11月1日2023年11月1日

またまたformat関数

四捨五入もしてくれるformatですが
VBAで
format(446/10,”0″)=45
なのですが
SQLserverでは
format(446/10,’0′)=44
なのです。

かなり慌てましたが
format(cast(446 as decimal)/10,’0′)=45 で　事なきを得ました。

2021年12月31日2022年1月10日

データベースエンジンの復旧ハンドルの待機に失敗しました

Windows11にsqlserver2019をインストールすると上記のエラー
いろいろ原因はあるようですがわたしの場合はSSDのセクターサイズでした。

https://docs.microsoft.com/ja-jp/troubleshoot/sql/admin/troubleshoot-os-4kb-disk-sector-size

https://duke13.com/win11-locdb-problem

cmdでfsutil fsinfo sectorinfo SSDドライブ　
セクターサイズが32768byteもある
sqlserverは512と4096しか対応していならしい。

Windows7の時も4096のHDDが出てきてちょっと混乱したのを思い出しました。
修正あるまで待つか、レジストリいじるか、フォーマットからやりなおすか、HDDにインストか

その後SSDを

セクターあたりのバイト数 : 512
物理セクターあたりのバイト数 : 4096
クラスターあたりのバイト数 : 4096 (4 KB)
でフォーマットしてやり直しても同じエラー

さらにレジストリを追加してやっとインストできました

2021年1月26日2021年1月26日

サブクエリでorder by

sqlserverで
select * into tableA from (select * from tableB order by columnC asc)
はサブクエリでorder byは無効ですとエラーになりますがaccessでのクエリなら問題ない

2021年1月8日2021年1月8日

空文字の配列

array(“”,””)は配列
array(“”)も配列

split(“,”,”,”)は配列

なので
split(“”,”,”)=array(“”)
でこれも配列と思いきやさにあらず。

split(“”,”,”)は空配列

2021年1月8日2021年1月8日

selectした結果でupdate; accessの場合

以前

update tableA set
columnA=tableB.columnB
from tableA
inner join tableB
on tableA.ID=tableB.ID

とクエリ書いたけど、これはaccessのクエリでは通用しなかった。
sqlserverとは違うようです。

accessでは

update tableA inner join tableB on tableA.ID=tableB.ID
set
columnA=tableB.columnB

こちらが自然な気がする

2020年12月25日

Bluetooth コード45

突如、pcからbluetoothが消えてデバイスマネージャーにも出なくなる。
エラーコードは45で結構みなさん遭遇しているようです。
いろいろ調べて試したけど復旧できず、OSクリーンインストールまでしたけど出てこない。
CMOSクリアでやっと解決しました。

簡単なのに、、、最初にやるべきでした。

2020年9月28日2020年9月29日

XMLファイルを読み込むVBA

access VBA 遅延バインディングでとなると難しいです
https://vbaexcel.slavesystems.com/vba/?p=603　を参考にさせてもらい、accessのVBAなので二次元配列にノード名と値を入れ込む

再帰プロシージャ、難しい。

Option Compare Database
Private aryxml() As String
Private ixml As Long

Public Function parsexml()
Dim XML
Dim strfilepath As String
Dim returnary As Variant
Dim returnvalue As Integer

WizHook.Key = 51488399
returnvalue = WizHook.GetFileName(0, "", "", "", strfilepath, "", "すべてのファイル (*.*)|*.*", 0, 0, 8, True)
WizHook.Key = 0

returnary = Array(returnvalue, strfilepath)

If returnary(0) = -302 Then
    Exit function
End If

if not instr(returnary(1),chr(9))=0 then
 MsgBox “選択は一つにお願いします。”
 Exit function
End if

'Debug.Print returnary(1)

Set XML = CreateObject("MSXML2.DOMDocument.6.0")
XML.Load (returnary(1))
 
If (XML.parseerror.errorcode <> 0) Then
    MsgBox XML.parseerror.reason, vbCritical
End If

ixml = 0
    
Call getchildren(XML)

'Debug.Print "ubound " & UBound(aryxml, 2)
'Debug.Print aryxml(0, 0) & " " & aryxml(0, 1) & " " & aryxml(0, 2)
'Debug.Print aryxml(1, 0) & " " & aryxml(1, 1) & " " & aryxml(1, 2)
Set XML = Nothing
‘Erase aryxml

End Function

Private Function getchildren(xmlparent As Variant)
On Error Resume Next

Dim e

For Each e In xmlparent.childnodes
    If e.childnodes.length = 0 Then
        If Not xmlparent.basename = "" Then
                ReDim Preserve aryxml(1, ixml)
                    aryxml(0, ixml) = xmlparent.basename
                    aryxml(1, ixml) = e.text
        End If
    Else
        Call getchildren(e)
    End If
Next
ixml = ixml + 1

End Function

Option Compare Database

Private aryxml() As String

Private ixml As Long

Public Function parsexml()

Dim XML

Dim strfilepath As String

Dim returnary As Variant

Dim returnvalue As Integer

WizHook.Key = 51488399

returnvalue = WizHook.GetFileName(0, "", "", "", strfilepath, "", "すべてのファイル (*.*)|*.*", 0, 0, 8, True)

WizHook.Key = 0

returnary = Array(returnvalue, strfilepath)

If returnary(0) = -302 Then

Exit function

End If

if not instr(returnary(1),chr(9))=0 then

MsgBox “選択は一つにお願いします。”

Exit function

End if

'Debug.Print returnary(1)

Set XML = CreateObject("MSXML2.DOMDocument.6.0")

XML.Load (returnary(1))

If (XML.parseerror.errorcode <> 0) Then

MsgBox XML.parseerror.reason, vbCritical

End If

ixml = 0

Call getchildren(XML)

'Debug.Print "ubound " & UBound(aryxml, 2)

'Debug.Print aryxml(0, 0) & " " & aryxml(0, 1) & " " & aryxml(0, 2)

'Debug.Print aryxml(1, 0) & " " & aryxml(1, 1) & " " & aryxml(1, 2)

Set XML = Nothing

‘Erase aryxml

End Function

Private Function getchildren(xmlparent As Variant)

On Error Resume Next

Dim e

For Each e In xmlparent.childnodes

If e.childnodes.length = 0 Then

If Not xmlparent.basename = "" Then

ReDim Preserve aryxml(1, ixml)

aryxml(0, ixml) = xmlparent.basename

aryxml(1, ixml) = e.text

End If

Else

Call getchildren(e)

End If

ixml = ixml + 1

End Function

2020年7月31日

ヒントテキスト出ない件

accessフォームで動的ヒントテキストというものを使ったのですが、以前書いた通り開発機のみで表示されない件について。
その後フォームをよく見ているとカーソルが微妙に点滅しているのに気が付きました。
ひょっとしてと思って例の高DPI設定を変更すると表示されるようになりました。

2020年6月24日2020年6月29日

WSUS WIDからSQL server expressへ移行　覚え書き

ドメコンのままでは難しくてできなかった
降格した後AD削除
SQL server express　インスト
サーバ名　\\.\pipe\microsoft##wid\tsql\query　のWIDからSUSDBデタッチ
expressの新しいインスタンスにアタッチ
新しいログイン　NT AUTHORITY\NETWORK SERVICE　サーバロール　publicとsysadmin　ユーザーマッピング　SUSDBにpublicとwebservice

以下はregeditで
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Update Services\Server\Setup
SqlServerName　は　インスタンス名
SqlDatabaseName　は　SUSDB
\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Update Services\Server\Setup\Installed Role Services
UpdateServices-WID　を　UpdateServices-Database　に変更

なぜ移行したというとSSMSでデータ圧縮とかインデックス再構築とかやりたかったから。
ここまで来てexpressではできないことが判明

でもクエリではできるらしい。
クエリ例
dbcc shrinkdatabase(susdb,10)
exec sp_MSforeachtable @command1=’if object_id(”susdb.?”) is not null dbcc DBREindex(”susdb.?”);’

難しかった

2020年5月23日2020年5月23日

recordsetclone

先日、accessのフォームを作成中
表示されたデータでテーブルを更新しようと・・。

ソースのクエリが複雑で面倒くさい。
フォームの値をそのまま使おうと、こういう時はme.recordsetだよなと・・

しかし動作時にカーソルが動きすぎてみっともない。で、この時ハッとrecordsetcloneてこういう時のためににあるのかな？と気が付きました。

違っているかもしれないですが書き留めておきます。

2024年4月
月	火	水	木	金	土	日
« 11月
1	2	3	4	5	6	7
8	9	10	11	12	13	14
15	16	17	18	19	20	21
22	23	24	25	26	27	28
29	30