本機能は、ローカルディスクから起動させないと動作しません。下の画像をクリックしてダウンロードしたZIPファイルをローカルディスク上のどこかのフォルダに解凍させてから実行して下さい。
(画像をクリックすると、このサンプルがダウンロードできます)
「INIファイル読み込み」「INIファイル更新」がありますが、最初はINIファイル自体が存在しないので「INIファイル更新」をクリックして下さい。
INIファイルに登録する文字列を入力するダイアログが表示されるので、適当な文字列を入力して下さい。
「OK」をクリックするとINIファイルに登録されます。
次に、「INIファイル読み込み」を行なうと、上記で登録した文字列がメッセージボックスで表示されるのが確認できると思います。
但し、デフォルトは「DEFAULT」としています。上記の登録で文字列を消去して「OK」をクリックすると、INIファイル内ではキーが削除されるため、「消したのに消えていない」ように見えますが、このような仕様にしているための結果です。
実際のINIファイルは、本Excelワークブックを保存したフォルダに作成される「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 >>--------------------------------------
(1) | strAppName | アプリケーション名(グループ名)を指定します。ここで指定された名前はカギ括弧の付いたアプリケーション名(グループ名)として探されます。 (上のサンプルだと「TESTSEC」です。 |
(2) | strKeyName | 項目名を指定します。 |
(3) | strDefault | 項目がINIファイルに見つからない場合に返すデフォルト値を指定します。 |
(4) | strFileName | INIファイルの物理ファイル名をフルパスで指定します。 |