API関連(APIの利用の例)

オンラインソフトなど、レジストリに設定内容を登録することを好まないアプリケーションでは、拡張子が「*.INI」となる設定ファイルを独自に作成して設定内容を登録し用いることは良くありますが、この設定ファイルとのやりとりを行なうAPIです。

INIファイルとは？プログラム内で固定できない設定情報を登録するためのものなのですが、プログラムの実行環境であったり、ユーザー情報である場合もあります。
ここではExcelワークブックなのでこのサンプルはそのワークブックが置かれているフォルダにINIファイルを作成します。古くは実行形式ファイル(*.exe)がやはりその実行形式ファイルのフォルダにINIファイルを作成する構造のプログラムが多くありましたが、現在ではProgram Filesフォルダはセキュリティ上で簡単には書き込みができないことや、ユーザーレベルの情報を配置する場所ではないので適しません。
Excelワークブックであればこのようなことはないのですが、ネットワーク上に配置する場合は起動ユーザーに関わらず同一フォルダになってしまうので、ユーザーの裁量に関係する情報を置くには向かないということになります。さらに、INIファイルそのものは単なるテキストファイルなので、プログラムから定められた方法でなくても「メモ帳」などでの参照・書き換えも可能だという問題もあります。
ですから「見られても良い設定情報」として次回のプログラム起動時にも反映させることができる情報を保持させる仕組みとして利用する方法のひとつと考えて下さい。

なお、ExcelVBAでこのような設定情報を保持する必要があるようなプログラムを作成するのか、という疑問にも遭遇します。
例えばVB.NETであればプロジェクトの「設定」に登録するだけで登録初期値を含めてAPIなど使わずに簡単に設定情報の参照・登録ができるので、当サイトの「ダウンロード」にある「一般用フリーソフト」などでも積極的に利用しています。

64ビット版Excelの対応を行ないました。このページのサンプルはAPIを使用しております。
Office365やOffice2019では、64ビット版になるという情報があったため、当サイトでも順次この対応を行ない、動作確認ができたものからページを更新しています。

本機能は、ローカルディスクから起動させないと動作しません。下の画像をクリックしてダウンロードしたZIPファイルをローカルディスク上のどこかのフォルダに解凍させてから実行して下さい。

(画像をクリックすると、このサンプルがダウンロードできます)
「INIファイル読み込み」「INIファイル更新」がありますが、最初はINIファイル自体が存在しないので「INIファイル更新」をクリックして下さい。

INIファイルに登録する文字列を入力するダイアログが表示されるので、適当な文字列を入力して下さい。

「OK」をクリックするとINIファイルに登録されます。

次に、「INIファイル読み込み」を行なうと、上記で登録した文字列がメッセージボックスで表示されるのが確認できると思います。

但し、デフォルトは「DEFAULT」としています。上記の登録で文字列を消去して「OK」をクリックすると、INIファイル内ではキーが削除されるため、「消したのに消えていない」ように見えますが、このような仕様にしているための結果です。

実際のINIファイルは、本Excelワークブックを保存したフォルダに作成される「SAMPLE.ini」です。メモ帳等にドラッグして開けば、内容はテキストなので確認できると思います。
SAMPLE.iniをメモ帳で開いたところ
サンプルでは、アプリケーション名(グループ名)が、「TESTSEC」、キー名が「TEST」という単一項目ですので、このようなINIファイルが作成されます。
しかし、INIファイルは複数の設定項目が混在していても問題なく動作するようになっているので、この前後に他の項目を追加して動作させてみて下さい。

ソースコードです。


'***************************************************************************************************
'   iniファイル読込み／書き込み                                     Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 04/11/13(1.0.0)新規作成
' 17/11/14(1.0.0)再作成
' 19/10/20(2.0.0)64ビットWindows対応
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsStringLngs As Long = 256                         ' 文字列長上限
' サンプルで使うデータ
Private Const g_cnsAppName As String = "TESTSEC"                    ' アプリケーション名
Private Const g_cnsKeyName As String = "TEST"                       ' キー名
Private Const g_cnsDefault As String = "DEFAULT"                    ' デフォルト値
Private Const g_cnsFileName As String = "SAMPLE.ini"                ' iniファイル名
'---------------------------------------------------------------------------------------------------
#If VBA7 Then
' ■iniファイル読込み(API:String)
Private Declare PtrSafe Function GetPrivateProfileString _
    Lib "KERNEL32.dll" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, _
     ByVal lpKeyName As String, _
     ByVal lpDefault As String, _
     ByVal lpReturnedString As String, _
     ByVal nSize As Long, _
     ByVal lpFileName As String) As Long
'---------------------------------------------------------------------------------------------------
' ■iniファイル書き込み(API:String)
Private Declare PtrSafe Function WritePrivateProfileString _
    Lib "KERNEL32.dll" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, _
     ByVal lpKeyName As String, _
     ByVal lpString As Any, _
     ByVal lpFileName As String) As Long
#Else
' ■iniファイル読込み(API:String)
Private Declare Function GetPrivateProfileString _
    Lib "KERNEL32.dll" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, _
     ByVal lpKeyName As String, _
     ByVal lpDefault As String, _
     ByVal lpReturnedString As String, _
     ByVal nSize As Long, _
     ByVal lpFileName As String) As Long
'---------------------------------------------------------------------------------------------------
' ■iniファイル書き込み(API:String)
Private Declare Function WritePrivateProfileString _
    Lib "KERNEL32.dll" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, _
     ByVal lpKeyName As String, _
     ByVal lpString As Any, _
     ByVal lpFileName As String) As Long
#End If

'***************************************************************************************************
'   ■■■ シート上のボタンから呼び出される処理 ■■■
'***************************************************************************************************
'* 処理名　：Button1_Click
'* 機能　　：｢INIファイルの読み込み｣ボタンクリック
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2004年11月13日
'* 作成者　：井上　治
'* 更新日　：2017年11月14日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Button1_Click()
    '-----------------------------------------------------------------------------------------------
    Dim strIniString As String                                      ' iniファイル読み出し値
    Dim strErrMSG As String                                         ' エラーメッセージ
    ' iniファイル読込み
    If FP_GetIniString(g_cnsAppName, _
                       g_cnsKeyName, _
                       g_cnsDefault, _
                       strIniString, _
                       strErrMSG) Then
        ' 結果の表示(成功)
        MsgBox "読出し値=" & strIniString, vbInformation
    Else
        ' エラー表示
        MsgBox strErrMSG, vbCritical
    End If
End Sub

'***************************************************************************************************
'* 処理名　：Button2_Click
'* 機能　　：｢INIファイルの更新｣ボタンクリック
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2004年11月13日
'* 作成者　：井上　治
'* 更新日　：2017年11月14日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Button2_Click()
    '-----------------------------------------------------------------------------------------------
    Dim strIniString As String                                      ' iniファイル読み出し値
    Dim strErrMSG As String                                         ' エラーメッセージ
    '-----------------------------------------------------------------------------------------------
    ' InputBoxで書き込み値を受け取る
    strIniString = InputBox("INIファイルに登録する文字列を入力して下さい。", _
                            "INIファイル書き込み", _
                            g_cnsDefault)
    ' 未入力は終了
    If strIniString = "" Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' iniファイル書込み
    If FP_SetIniString(g_cnsAppName, _
                       g_cnsKeyName, _
                       strIniString, _
                       strErrMSG) Then
        ' 成功すると「True」が返ります
        MsgBox "iniファイル更新成功"
    Else
        ' エラー表示
        MsgBox strErrMSG, vbCritical
    End If
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：FP_GetIniString
'* 機能　　：iniファイル読込み(String)
'---------------------------------------------------------------------------------------------------
'* 返り値　：処理成否(Boolean)
'* 引数　　：Arg1 = アプリケーション名(String)
'* 　　　　　Arg2 = キー名(String)
'* 　　　　　Arg3 = デフォルト値(string)
'* 　　　　　Arg4 = 読み出し値(String)                  ※Ref参照
'* 　　　　　Arg5 = エラーメッセージ(String)            ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2004年11月13日
'* 作成者　：井上　治
'* 更新日　：2017年11月14日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetIniString(ByVal strAppName As String, _
                                 ByVal strKeyName As String, _
                                 ByVal strDefault As String, _
                                 ByRef strIniString As String, _
                                 ByRef strErrMSG As String) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim strBuffer As String                                         ' テキストバッファ
    Dim lngLngs As Long                                             ' 文字列長
    Dim lngRet As Long                                              ' 戻り値
    '-----------------------------------------------------------------------------------------------
    ' 初期処理
    FP_GetIniString = False
    strIniString = ""
    strErrMSG = ""
    ' Bufferを確保(256文字を上限とする)
    strBuffer = String(g_cnsStringLngs, Chr(0))
    lngLngs = Len(strBuffer)
    On Error Resume Next
    '-----------------------------------------------------------------------------------------------
    ' INIファイルから文字列を読み出す(API利用)
    lngRet = GetPrivateProfileString(strAppName, _
                                     strKeyName, _
                                     strDefault, _
                                     strBuffer, _
                                     lngLngs, _
                                     FP_GetIniFilename())
    '-----------------------------------------------------------------------------------------------
    ' エラー判定
    If Err.Number <> 0 Then
        strErrMSG = Err.Description
    ElseIf lngRet > 0 Then
        ' 成功の場合は､NULLの手前までを取り出す
        lngLngs = InStr(strBuffer, Chr(0))
        strIniString = Trim$(Left$(strBuffer, lngLngs - 1))
        FP_GetIniString = True
    Else
        ' 不成功(ファイル無し等)の場合はデフォルト値をセット
        strIniString = strDefault
        ' iniファイル書込み(デフォルト値)
        FP_GetIniString = FP_SetIniString(strAppName, strKeyName, strIniString, strErrMSG)
    End If
    On Error GoTo 0
End Function

'***************************************************************************************************
'* 処理名　：FP_SetIniString
'* 機能　　：iniファイル書込み(String)
'---------------------------------------------------------------------------------------------------
'* 返り値　：処理成否(Boolean)
'* 引数　　：Arg1 = アプリケーション名(String)
'* 　　　　　Arg2 = キー名(String)
'* 　　　　　Arg3 = 書き込み値(string)
'* 　　　　　Arg4 = エラーメッセージ(String)            ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2004年11月13日
'* 作成者　：井上　治
'* 更新日　：2017年11月14日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_SetIniString(ByVal strAppName As String, _
                                 ByVal strKeyName As String, _
                                 ByRef strIniString As String, _
                                 ByRef strErrMSG As String) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim blnRet As Boolean                                           ' 戻り値
    FP_SetIniString = False
    strErrMSG = ""
    On Error Resume Next
    '-----------------------------------------------------------------------------------------------
    ' iniファイル書き込みを行なう(API利用)
    blnRet = WritePrivateProfileString(strAppName, strKeyName, strIniString, FP_GetIniFilename())
    '-----------------------------------------------------------------------------------------------
    ' エラー判定
    If Err.Number <> 0 Then
        strErrMSG = Err.Description
    ElseIf blnRet Then
        FP_SetIniString = True
    Else
        strErrMSG = "iniファイルの書き込みに失敗しました。"
    End If
    On Error GoTo 0
End Function

'***************************************************************************************************
'* 処理名　：FP_GetIniFilename
'* 機能　　：iniファイル名取得
'---------------------------------------------------------------------------------------------------
'* 返り値　：iniファイル名(String)                      ※フルパス
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2017年11月14日
'* 作成者　：井上　治
'* 更新日　：2017年11月14日
'* 更新者　：井上　治
'* 機能説明：本ブックのフォルダにある｢SAMPLE.ini｣を返す
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetIniFilename() As String
    '-----------------------------------------------------------------------------------------------
    Dim objFSO As FileSystemObject                                  ' FileSystemObject
    Set objFSO = New FileSystemObject
    FP_GetIniFilename = objFSO.BuildPath(ThisWorkbook.Path, g_cnsFileName)
    Set objFSO = Nothing
End Function

'------------------------------------------<< End of Source >>--------------------------------------

読み出しについては、このFunctionプロシージャが流用できると思います。
FP_GetIniStringの引数は以下の通りです。

(1)	strAppName	アプリケーション名(グループ名)を指定します。ここで指定された名前はカギ括弧の付いたアプリケーション名(グループ名)として探されます。 (上のサンプルだと「TESTSEC」です。
(2)	strKeyName	項目名を指定します。
(3)	strDefault	項目がINIファイルに見つからない場合に返すデフォルト値を指定します。
(4)	strFileName	INIファイルの物理ファイル名をフルパスで指定します。

これにより、戻り値にINIファイルの該当項目の設定値が返されます。

INIファイルの読み書き。