【ACCESS/EXCEL/VBA】末尾全角文字化け回避用 拡張LeftBサンプル

---

LeftBでは末尾の全角文字列1バイトが切られてしまう場合、末尾の全角文字列が文字化けする。
全角文字列の文字化けを考慮する場合は別途チェックが必要になる。

---

■文字化け回避用のLeftB拡張モジュールサンプル（末尾切り上げ/切り捨て、全半角混在も対応）

' 引数説明
'      prm：対象文字列
'   length：取得バイト数
'  convert：True時Nullを""に変換/False時Nullをそのまま返す
' truncate：True時末尾切り捨て  /False時末尾切り上げ
Private Function ExLeftB(ByVal prm As Variant, _
                         ByVal length As Integer, _
                         Optional ByVal convert As Boolean = True, _
                         Optional ByVal truncate As Boolean = True) As Variant
    Dim cnvStr As String
    ' Accessの場合
    cnvStr = StrConv(Nz(prm, ""), vbFromUnicode)
    ' Excelの場合
    ' cnvStr = StrConv(IIf(IsNull(prm), "", prm), vbFromUnicode)
    
    If LenB(cnvStr) <= length Then
        ExLeftB = IIf(convert, Nz(prm), prm)
        Exit Function
    End If
    
    Dim leftNormal As Variant
    Dim leftTrunc As Variant
    Dim leftRoundUp As Variant
    leftNormal = StrConv(LeftB(cnvStr, length), vbUnicode)
    leftTrunc = StrConv(LeftB(cnvStr, length - 1), vbUnicode)
    leftRoundUp = StrConv(LeftB(cnvStr, length + 1), vbUnicode)
    
    If Len(leftNormal) <> Len(leftRoundUp) Then
        ExLeftB = leftNormal
        Exit Function
    Else
        ExLeftB = IIf(truncate, leftTrunc, leftRoundUp)
        Exit Function
    End If
End Function
 

---

■使用例

Private Sub dammy()
    Debug.Print ("---------------------")
    Debug.Print ("Nullコンバートする")
    Debug.Print (ExLeftB(Null, 3))
    Debug.Print ("---------------------")
    Debug.Print ("Nullコンバートしない")
    Debug.Print (ExLeftB(Null, 3, False))
    Debug.Print ("---------------------")
    Debug.Print ("切り捨て出力")
    Debug.Print (ExLeftB("あああ", 5))
    Debug.Print ("---------------------")
    Debug.Print ("切り上げ出力")
    Debug.Print (ExLeftB("あああ", 5, truncate:=False))
    Debug.Print ("---------------------")
End Sub

■実行結果

【SQL Server】NULLを変換する（ISNULL,COALESCEの違い)

---

NULL変換を行う場合にはISNULL、COALESCEの2種類の変換方法がある。

---

①ISNULLを使用する場合
■書き方等
　ISNULL(第一引数, 第二引数)
　ISNULLは第一引数がNULLの場合に第二引数の値を返す。 　戻り値型は第一引数と同じ。
■使用例
テーブル名：[TEST_TBL1]

column1	column2	column3	column4
1	列を	NULL	NULL
2	NULL	成せ汝	NULL
3	NULL	NULL	従順の下僕
4	NULL	NULL	NULL

実行するSQL

  SELECT ISNULL(column1,'Big Brother') AS C1
       , ISNULL(column2,'Big Brother') AS C2
       , ISNULL(column3,'Big Brother') AS C3
       , ISNULL(column4,'Big Brother') AS C4
  FROM TEST_TBL1

実行結果

C1	C2	C3	C4
1	列を	Big Brother	Big Brother
2	Big Brother	成せ汝	Big Brother
3	Big Brother	Big Brother	従順の下僕
4	Big Brother	Big Brother	Big Brother

---

②COALESCEを使用する場合
■書き方等 　COALESCE(第一引数, 第二引数, 第三引数, …)
　COALESCEは第一引数から順番に評価を行い、NULLでない最初の引数を返す。
　戻り値型は引数で使用されている型の中で型の優先度が高いものが使用される。
■使用例
テーブル名：[TEST_TBL1]

column1	column2	column3	column4
1	列を	NULL	NULL
2	NULL	成せ汝	NULL
3	NULL	NULL	従順の下僕
4	NULL	NULL	NULL

・例.1：第二引数まで指定する場合（ISNULL
　実行するSQL

  SELECT COALESCE(column1, 'Big Brother') AS C1
       , COALESCE(column2, 'Big Brother') AS C2
       , COALESCE(column3, 'Big Brother') AS C3
       , COALESCE(column4, 'Big Brother') AS C4
  FROM TEST_TBL1

　実行結果

C1	C2	C3	C4
1	列を	Big Brother	Big Brother
2	Big Brother	成せ汝	Big Brother
3	Big Brother	Big Brother	従順の下僕
4	Big Brother	Big Brother	Big Brother

・例.2：第三引数以降も指定した場合
　実行するSQL

  SELECT COALESCE(column2 , column3, column4, 'BigBrother') AS C1
  FROM TEST_TBL1

　実行結果

C1

列を

成せ汝

従順の下僕

Big Brother

---

■ISNULLとCOALESCEの違い
引数に指定できる個数以外は同等にみえるが、
それぞれ変換後の型の扱いに違いがあることに注意が必要。

ISNULLは「第一引数と同じ」
COALESEは「引数で使用されている型の中で型の優先度が高いものが使用される」

例えば以下のようなSQLを実行した場合はCOALESEではエラーが発生することがある。
・ISNULLを使用した場合

 SELECT ISNULL('AAA' , 2) AS C1

C1

AAA

・COALESCEを使用した場合

 SELECT COALESCE('AAA' , 2) AS C1

メッセージ 245、レベル 16、状態 1、行 1
varchar の値 'AAA' をデータ型 int に変換できませんでした。

COALESCEを使用した場合はvarchar型の’AAA’を

型の優先度が高いint型に変換しようとしエラーが発生する。

---

【ACCESS/EXCEL/VBA】ログ出力を行うモジュールサンプル

---

ACCESSのみで動作確認をしていますがEXCELでもそのまま使えると思います。
かゆいところに手が届かない部分や雑な箇所があるので、必要に応じてカスタマイズして使用してください。

---

①ファイル出力処理用に
　事前に[ツール]→[参照設定]から[Microsoft Scripting Runtime]を追加する


②以下ログ出力モジュール

Option Compare Database
Option Explicit
 
Private Type systemTime
    Year As Integer
    Month As Integer
    DayOfeek  As Integer
    Day  As Integer
    Hour As Integer
    Minute As Integer
    Second As Integer
    Milliseconds As Integer
End Type
 
Private Declare Sub GetSystemTime Lib "kernel32" (systemTime As systemTime)
Private MeasureStartTime As systemTime
Private MeasureEndTime As systemTime
Private IntermStartTime As systemTime
Private IntermEndTime As systemTime
Private MeasureLog As String
 
Public Sub MeasureStart()
    MeasureStartTime = GetDetailSysTime
    MeasureLog = "計測開始：" & GetFormatSysTime(MeasureStartTime) & vbCrLf
End Sub
 
Public Sub MeasureEnd()
    MeasureEndTime = GetDetailSysTime
    MeasureLog = MeasureLog & _
                 "計測終了：" & GetFormatSysTime(MeasureEndTime) & vbCrLf & _
                 "計測時間：" & GetMeasureTime(IntermStartTime, IntermEndTime) & vbCrLf
                 
    Call OutPutText("Log" & GetUnFormatSysTime(MeasureStartTime), MeasureLog)
End Sub
 
Public Sub IntermStart()
    IntermStartTime = GetDetailSysTime
End Sub
 
Public Sub IntermEnd(ByVal text As String)
    IntermEndTime = GetDetailSysTime
    MeasureLog = MeasureLog & _
                 text & _
                 ":" & _
                 GetFormatSysTime(IntermStartTime) & vbTab & _
                 GetFormatSysTime(IntermEndTime) & vbTab & _
                 GetMeasureTime(IntermStartTime, IntermEndTime) & vbCrLf
End Sub
 
Public Sub AddLog(ByVal text As String)
    MeasureLog = MeasureLog & _
                 text & _
                 ":" & vbTab & _
                 GetFormatSysTime(GetDetailSysTime) & vbCrLf
End Sub
 
Private Function GetDetailSysTime() As systemTime
    Dim sysTime As systemTime
    GetSystemTime sysTime
    GetDetailSysTime = sysTime
End Function
 
Private Sub OutPutText(ByVal fileName As String, ByVal text As String)
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
 
    Dim ts As TextStream
    Set ts = fso.CreateTextFile(wsh.SpecialFolders("Desktop") & "\" & fileName & ".txt", Overwrite:=True, Unicode:=True)
 
    ts.Write (text)
    
    ts.Close
    Set wsh = Nothing
    Set ts = Nothing
    Set fso = Nothing
End Sub
 
Private Function GetFormatSysTime(ByRef sysTime As systemTime) As String
    GetFormatSysTime = CStr(sysTime.Year) & "/" & _
                       Format(sysTime.Month, "00") & "/" & _
                       Format(sysTime.Day, "00") & " " & _
                       Format(sysTime.Hour, "00") & ":" & _
                       Format(sysTime.Minute, "00") & ":" & _
                       Format(sysTime.Second, "00") & "." & _
                       Format(sysTime.Milliseconds, "000")
End Function
 
Private Function GetUnFormatSysTime(ByRef sysTime As systemTime) As String
    GetUnFormatSysTime = CStr(sysTime.Year) & _
                    Format(sysTime.Month, "00") & _
                    Format(sysTime.Day, "00") & _
                    Format(sysTime.Hour, "00") & _
                    Format(sysTime.Minute, "00") & _
                    Format(sysTime.Second, "00") & _
                    Format(sysTime.Milliseconds, "000")
End Function
 
Private Function GetMeasureTime(ByRef sysStartTime As systemTime, _
                                ByRef sysEndTime As systemTime) As String
    Dim startTime As Double
    Dim endTime As Double
    startTime = CDbl(Format(sysStartTime.Hour, "00") & _
                     Format(sysStartTime.Minute, "00") & _
                     Format(sysStartTime.Second, "00") & "." & _
                     Format(sysStartTime.Milliseconds, "000"))
    endTime = CDbl(Format(sysEndTime.Hour, "00") & _
                   Format(sysEndTime.Minute, "00") & _
                   Format(sysEndTime.Second, "00") & "." & _
                   Format(sysEndTime.Milliseconds, "000"))
                                
    GetMeasureTime = Format(CStr(endTime - startTime), "00:00:00.000")
End Function

---

---

③使用例
1.MeasureStartでログを取得開始、
　MeasureEndでログファイルをデスクトップに出力します。
※MeasureStart/MeasureEnd処理は計測時には必須処理となります。
2.MeasureStart～End間の処理で以下の関数を実行すると中間ログの取得が行えます。 　AddLog：引数テキスト、AddLog実行時の時刻をログファイルに出力します。 　IntermStart/IntermEnd：IntermStartで中間ログ計測開始、
　　　　　　　　　　　　 IntermEndで引数テキスト、Start/End時刻、Start～End間の時間をログファイルに出力します。

Private Sub LogSample()
    ' MeasureStart実行でログ計測を開始します
    Call MeasureStart
    
    ' 単純なログを残した場合はAddLogを使用します
    Call AddLog("AddLogサンプル①")
    
    ' 中間の処理時間を図りたい場合はIntermStart-IntermEndを使用します
    ' IntermEndの引数に指定した文言/IntermStartとEnd時刻/IntermEndまでの時間が出力されます。
    Call IntermStart
    ' --ダミー処理---
    Dim i As Long
    Dim str As String
    For i = 0 To 100000
        str = "dammy"
    Next i
    ' --ダミー処理---
    Call IntermEnd("IntermStart/End")
    
    Call AddLog("AddLogサンプル②")
    
    ' MeasureEnd実行でログファイルが出力されます
    Call MeasureEnd
End Sub

④実行結果 　[③使用例]のコードを実行した結果 　以下のファイルがデスクトップに出力される。

【ACCESS/EXCEL/VBA】現在時刻ミリ秒まで取得を行う

VBAの[ NOW() ]や[ DATE() ]関数ではミリ秒の取得が行えない。
ミリ秒まで取得を行いたい場合は[ Win32API ]を使用して別途自作する必要がある。

■以下取得関数サンプル

Option Compare Database
Option Explicit
 
Private Type systemTime
    Year As Integer
    Month As Integer
    DayOfeek  As Integer
    Day  As Integer
    Hour As Integer
    Minute As Integer
    Second As Integer
    Milliseconds As Integer
End Type
 
Private Declare Sub GetSystemTime Lib "kernel32" (systemTime As systemTime)
 
' 現在日時をミリ秒まで取得する関数
Public Function GetDetailSysTime() As String
    Dim sysTime As systemTime
    GetSystemTime sysTime
    
    GetDetailSysTime = CStr(sysTime.Year) & "/" & _
                       Format(sysTime.Month, "00") & "/" & _
                       Format(sysTime.Day, "00") & " " & _
                       Format(sysTime.Hour, "00") & ":" & _
                       Format(sysTime.Minute, "00") & ":" & _
                       Format(sysTime.Second, "00") & "." & _
                       Format(sysTime.Milliseconds, "000")
End Function

【ACCESS/VBA】SQL文実行サンプル

 Private Sub ExecSQL()
    Dim cmd As New ADODB.Command
    Dim conn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim rtn As Integer
    m_cn = New ADODB.Connection
    conn.ConnectionString = "DSN=TEST_ODBC;Uid=USER1;Pwd=userpass1;Database=TEST_DB"
    conn.Open
    
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = conn
    
    ' SELECT文（レコードセットに結果取得するパターン）
    With cmd
        .CommandText = "SELECT * " & _
                       "FROM TEST_TBL1 " & _
                       "WHERE column1 = ? AND " & _
                       "      column2 = ?;"
        .CommandType = adCmdText
        .Parameters(0).Value = 1        ' 1つ目?へのバインド
        .Parameters(1).Value = "AAA"    ' 2つ目?へのバインド
    End With
    Set rst = cmd.Execute
    rst.Close
    Set rst = Nothing
    
    ' UPDATE/INSERT文（レコードセットに結果取得しないパターン）
    With cmd
        .CommandText = "UPDATE TEST_TBL1 " & _
                       "SET   column2 = ? " & _
                       "WHERE column1 = ?;"
        .CommandType = adCmdText
        .Parameters(0).Value = "BBB"        ' 1つ目?へのバインド
        .Parameters(1).Value = 1    ' 2つ目?へのバインド
    End With
    Call cmd.Execute
 
    With cmd
        .CommandText = "INSERT INTO TEST_TBL1(" & _
                       "    column1, " & _
                       "    column2 " & _
                       ")VALUES(" & _
                       "    ?," & _
                       "    ?);"
        .CommandType = adCmdText
        .Parameters(0).Value = 2        ' 1つ目?へのバインド
        .Parameters(1).Value = "CCC"    ' 2つ目?へのバインド
    End With
    Call cmd.Execute
    
    Set cmd = Nothing
 End Sub

【ACCESS/VBA】ストアドプロシージャ実行サンプル

①ストアド内のSELECT結果を取得する場合

Private Sub ExecSP()
    Dim cmd As New ADODB.Command
    Dim conn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim rtn As Integer
    m_cn = New ADODB.Connection
    conn.ConnectionString = "DSN=TEST_ODBC;Uid=USER1;Pwd=userpass1;Database=TEST_DB"
    conn.Open
    
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = conn
    
    With cmd
        .CommandText = "usp_sp1"
        .CommandType = adCmdStoredProc
        .Parameters.Refresh
        .Parameters(1).Value = 100 ' ストアド引数1つ目
        .Parameters(2).Value = 200 ' ストアド引数2つ目
    End With
    
    ' ストアドプロシージャ内で最後に実行されたSQLの結果を取得
    Set rst = cmd.Execute
    ' ストアドプロシージャのReturn値を取得
    rtn = cmd.Parameters(0).Value
    
    rst.Close
    Set rst = Nothing
    Set cmd = Nothing
    
 End Sub

②ストアド内のSELECT結果を取得しない場合

Private Sub ExecSP()
    Dim cmd As New ADODB.Command
    Dim conn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim rtn As Integer
    m_cn = New ADODB.Connection
    conn.ConnectionString = "DSN=TEST_ODBC;Uid=USER1;Pwd=userpass1;Database=TEST_DB"
    conn.Open
    
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = conn
    
    With cmd
        .CommandText = "usp_sp1"
        .CommandType = adCmdStoredProc
        .Parameters.Refresh
        .Parameters(1).Value = 100 ' ストアド引数1つ目
        .Parameters(2).Value = 200 ' ストアド引数2つ目
        .Execute
    End With
    
    ' ストアドプロシージャのReturn値を取得
    rtn = cmd.Parameters(0).Value
    
    rst.Close
    Set rst = Nothing
    Set cmd = Nothing
    
 End Sub

【ACCESS/VBA】ADODB接続サンプル

①事前に[ツール]→[参照設定]から[Microsoft ActiveX Data Objects X.X Library]を追加する
※参照設定を使用しない場合は不要
















②以下サンプル（接続文字列はODBC接続）

Option Compare Database
Option Explicit
 
Private Const CON_STRING As String = "DSN=TEST_ODBC;Uid=USER1;Pwd=userpass1;Database=TEST_DB"
Private m_cn As New ADODB.Connection
 
' コネクションオープン用
Public Sub OpenConnection()
    m_cn = New ADODB.Connection
    m_cn.ConnectionString = CON_STRING
    m_cn.Open
End Sub
 
' コネクションクローズ用
Public Sub CloseConnection()
    m_cn.Close
End Sub
 
' コネクション取得用
Public Function GetConnection() As ADODB.Connection
    Set GetConnection = m_cn
End Function

③使用例

Option Compare Database
Private Sub test()
    Dim rst As New ADODB.Recordset
    Call OpenConnection
    
    rst.ActiveConnection = M_Connection.GetConnection
    rst.Open "select * from TEST_TBL1;"
    rst.Close
 
    Set rst = Nothing
    Call CloseConnection
End Sub