【Access】Access(64bit)でiniファイル取得方法

以前、iniファイル取得方法についてご紹介しましたが、 64bit環境で行うと長い文字数を上手く取れないことがあり、コードを変更しました。ReadINI関数は現在は使わず、下記のような関数を使用しています。

32bit 64bit両方で使用可能なAPIの宣言

※2021年2月7日 宣言追加しました

APIの宣言

'------------
Option Compare Database
Option Explicit

' Windows  APIの宣言
#If VBA7 And Win64 Then
    ' 64Bit 版
    Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
            (ByVal lpApplicationName As String, _
             ByVal lpKeyName As Any, _
             ByVal lpDefault As String, _
             ByVal lpReturnedString As String, _
             ByVal nSize As Long, _
             ByVal lpFileName As String) As Long
#Else
    ' 32Bit 版
    Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
            (ByVal lpApplicationName As String, _
             ByVal lpKeyName As Any, _
             ByVal lpDefault As String, _
             ByVal lpReturnedString As String, _
             ByVal nSize As Long, _
             ByVal lpFileName As String) As Long
#End If

関数1(ODBC接続文字列取得)

'Rem ----------------------------------------------------------------------------------
'Rem     関数名   : getLnkPath
'Rem     処理内容 : ODBC接続文字列取得
'Rem     引  数　 : なし
'Rem     戻り値　 : 接続文字列
'Rem ----------------------------------------------------------------------------------
Public Function getLnkPath() As String
Dim lnkPath As String
Dim strDbPath As String
Dim ret As Boolean

On Error GoTo Error

'    strDbPath = ReadINI("DB_INF", "DB_PATH")

    ' DBのフォルダ取得
    ret = ktINI_GetValue("DB_INF", "DB_PATH", strDbPath)
    If ret = False Then
        MsgBox "環境設定ファイルを確認してください。" + Chr$(10) + "読み込めませんでした。", vbCritical
        Exit Function
    End If
    
    ' 接続文字列取得
    lnkPath = strDbPath & C_DB_NAME
    getLnkPath = lnkPath
Exit Function
Error:
    MsgBox "環境設定ファイルを確認してください。" + Chr$(10) + "読み込めませんでした。", vbCritical
End Function

関数2(ktINI_GetValue関数)

ktINI_GetValue関数を新たに追加しました。

'Rem ----------------------------------------------------------------------------------
'Rem     関数名   : ktINI_GetValue
'Rem     処理内容 : Section/Key指定で値を取得
'Rem     引  数　 : Section,Entry
'Rem     戻り値　 : 無し
'Rem ----------------------------------------------------------------------------------
Public Function ktINI_GetValue _
            (ByVal SectionName As String, _
             ByVal KeyName As String, _
             ByRef ValueString As String) As Boolean
             
Dim strReturnedString As String * 32767
Dim strValue As String
Dim i As Integer
Dim blnFlag As Boolean
Dim rc As Long
Dim strFileName As String
    
    ' INIファイルパス
    strFileName = MyPath & C_INI_FILE_NAME

    If (strFileName = "") Or (SectionName = "") Or (KeyName = "") Then
        ktINI_GetValue = False
        Exit Function
    ElseIf (LCase(Right(strFileName, 4)) <> ".ini") Or (InStr(strFileName, "\") = 0) Then
        '識別子ＮＧ,フルパス無し
        ktINI_GetValue = False
        Exit Function
    ElseIf (Dir(strFileName, vbNormal) = "") Then
        'INIファイル無し
        ktINI_GetValue = False
        Exit Function
    End If

On Error Resume Next
    rc = GetPrivateProfileString(SectionName, KeyName, vbNullString, strReturnedString, Len(strReturnedString), strFileName)
On Error GoTo 0
    If (rc = 0) Then
        ktINI_GetValue = False
        Exit Function
    End If

    ' 返却文字列よりデータを抽出
    blnFlag = False
    strValue = ""
    For i = 1 To Len(strReturnedString)
        If Mid(strReturnedString, i, 1) = vbNullChar Then
            If (blnFlag = True) Then    ' 2文字連続のvbNullChar
                Exit For
            Else
                strValue = strValue & Mid(strReturnedString, i, 1)
                blnFlag = True  ' 1文字目のvbNullChar
            End If
        Else
            strValue = strValue & Mid(strReturnedString, i, 1)
            blnFlag = False 'vbNullCharの後に文字が続けばFalseに戻す
        End If
    Next i
    ' 終端のvbNullCharを除去
    ValueString = Left(strValue, Len(strValue) - 1)
    ktINI_GetValue = True
    
End Function