【 2016年9月15日  サイト 移転のお知らせ 】
      AddinBox サイトを [ DION ] から [ さくら インターネット ] へ移転しました。  なお、旧サイト は 2017年10月 まで残します。
      この ページ の 移転先 URL  ⇒⇒  http://addinbox.sakura.ne.jp/Excel_Tips16.htm  
 
ロゴ(青) Excel/VBA Tips ロゴ(緑)

Tips16: INI ファイル操作関数

[ OpenOffice.org.Basic 逆移植版は こちら ]
   -- 2011/7/27 Ver 2.3 --
    ここで紹介している 関数よりも OOo.Basic へ移植したものの方が高機能となったので、OOo.Basic 版を
    VBA に逆移植しました(逆移植版の解説・ダウンロードは上記リンクより)。逆移植版では、Basic の
    入出力機能( Line Input / Print )で処理しています(API の 64bit 対応済です)。


- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
[ INI ファイル操作関数  API 利用版 ]    API の 64bit 対応済  

  昔から各種設定情報などを保存するのに利用されている『INI ファイル』は、入出力にAPI を
使用しますが、取得した文字列の処理などに難しい部分があります。そこで、難しいAPI 周りを
隠蔽して簡易に使えるように関数仕立てにしました。なお、INI ファイルを処理するAPI 周りの
コードは下記の書籍を参考にしました。
      大村あつし 著 「VBAユーザーのための Win32 API プログラミングガイド」  (絶版)

  INI ファイル操作関数は以下の5種類を用意しました。なお、この関数ではWindowsディレクトリ
にあるINI ファイルを誤って操作しないように、INI ファイルは全てフルパスを記述する仕様にし
てあります。また、各関数は返却値として成功(TRUE)/失敗(FALSE) を返します
  尚、下記関数を使用する際に、INI ファイルのオープン/クローズをユーザー側で行なう必要は
ありません。

    (a) ktINI_GetValue ( INI ファイル名 , Section , Key , Value )
        Section と Key を指定して、その値を文字列で取得します。
        取得に失敗した場合には、「値」引数に指定した変数の内容は実行前のままです。

    (b) ktINI_GetValueList ( INI ファイル名 , Section , Key_Value テーブル )
        Section を指定して、そのSection 内にある全ての「Key と 値」のセットを2次元配列(添え字
        は1〜)として取得します。Key の数は「UBound(配列変数,1) 」で得られます。なお、利用
        側では動的配列の定義が必要です。値は文字列で取得されます。
        取得に失敗した場合には、「リスト」引数に指定した配列変数の内容は実行前のままです。
        Section内に、Key がひとつも無い場合は返却値(FALSE)で配列変数の内容は実行前の
        ままです。

    (c) ktINI_GetSecKeyList ( INI ファイル名 , Section , Sec_Key テーブル )
        Section リスト または Key リストを1次元配列(添え字は1〜)として取得します。
        引数でSection を指定した場合は、そのSection 内にある全ての「Key 」が取得できます。
        引数のSection に空文字を指定した場合は、INI ファイル内にある全ての「Section 」が取得
        できます。Section またはKey の数は「UBound(配列変数) 」で得られます。なお、利用側で
        は動的配列の定義が必要です。
        取得に失敗した場合には、「リスト」引数に指定した配列変数の内容は実行前のままです。
        Section がひとつも無い、またはSection内にKeyがひとつも無い場合は返却値(FALSE)で
        配列変数の内容は実行前のままです。

    (d) ktINI_ReWrite ( INI ファイル名 , Section , Key , Value )
        Section と Key を指定して「値(文字列)」を書き込みます(数値の場合には、Format 関数
        により数値編集した内容を指定して下さい)。既に存在しているSection/Key の場合には変
        更処理、未登録のSection/Key の場合には追加処理となります。Key に空文字は指定でき
        ません。
        また、指定した INI ファイルが存在しない場合には自動的に指定のパスでファイルを作成した
        後に書き込みます。

    (e) ktINI_Delete ( INI ファイル名 , Section [ , Key ] )
        Section と Key を指定すると、その「Key 」を削除します。
        Key を省略(または空文字)すると、「Section 」を削除します。

【 INI ファイルの構造 】

    INI ファイルは、ファイル内に 『セクション』 という複数のグループを持ち、その中に複数の 『キー と 値』 の
  セットを持ちます。『キー』 の内容はセクション内では重複できませんが、セクションが異なれば同じキーの内
  容でも構いません。
    セクションの内容は 角カッコ( [  及び  ] ) で囲まれます。キー と 値 は1行に1件ずつ、キー と 値 の間を
  イコール記号( = )で繋いで記述します。尚、ユーザー側ではこのような構造について意識する必要はなく、
  上記の ktINI_ReWrite 関数により自動的にこのような構造で書き込まれます。

〜〜 例 〜〜

[日付]
開始日=2006/1/1
終了日=2008/12/31
[表示位置]
Top=300
Left=150
[VERSION]
ProgramA=1.0
ProgramB=1.7
ProgramC=3.1
[管理情報]                     ← 角カッコ内が セクション名
会社名=(株)AddinBox
担当者=角田
         
  キー    




====================================================================
    利用サンプルコード
====================================================================
・ CommandButton1 クリックで、INI 内の全セクション名を ListBox1 に表示。
・ ListBox1 内のセクション名をダブルクリックで、そのセクション内の全 [キー/値] をListBox2 に表示。


Private Sub CommandButton1_Click()
Dim strINI_Name As String
Dim strSec_List() As String
Dim rc As Boolean
Dim i As Integer

strINI_Name = "C:\ABC\DEF.ini"

rc = ktINI_GetSecKeyList(strINI_Name, "", strSec_List)
If (rc = FalseThen
  MsgBox "INI エラー"
  Exit Sub
End If
With ListBox1    '1列
  For i = 1 To UBound(strSec_List, 1)
    .AddItem strSec_List(i)   'Section
  Next i
End With
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim strINI_Name As String
Dim strINI_List() As String
Dim rc As Boolean
Dim i As Integer

strINI_Name = "C:\ABC\DEF.ini"

rc = ktINI_GetValueList(strINI_Name, ListBox1.Value, strINI_List)
If (rc = FalseThen
  MsgBox "INI エラー"
  Exit Sub
End If

With ListBox2    '2列
  For i = 1 To UBound(strINI_List, 1)
    .AddItem
    .List(.ListCount - 1, 0) = strINI_List(i, 1)   'Key
    .List(.ListCount - 1, 1) = strINI_List(i, 2)   'Value
  Next i
End With
End Sub



====================================================================
    INI ファイル操作関数のソースコード
====================================================================
標準モジュールを1つ用意して、以下のソースコードをコピーして下さい。
[ Option Private Module ] を使っていますので、これだけで1つの標準モジュールとします。

Ver 1.0  2006/1/10
Ver 1.1  2006/2/5
           a) prvINI_FileCreate 内で、Open ステートメントに指定するファイル番号を、
              #1 固定から FreeFile 関数 利用に変更しました。
Ver 1.2  2011/7/27
           a) フォルダが存在しない場合に [Open Output]によるファイル作成が失敗するバグを修正しました。
              (API : SHCreateDirectoryEx  を利用)
           b) API 宣言等を 64bit対応に修正しました。


   [ INI_Functions_API.xls    Ver1.2  (87KB) ]

Option Explicit

Option Private Module   '←Functionなので、シート不可とする為に必須
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
'_/
'_/   INIファイルの操作関数    (Ver1.2)
'_/
'_/     ktINI_GetValue      :1つのValueを取得
'_/     ktINI_GetValueList  : Key&Valueリストを取得
'_/     ktINI_GetSecKeyList : Sectionリスト or Keyリストを取得
'_/     ktINI_ReWrite       : Valueの追加/変更
'_/     ktINI_Delete        : Section or Keyの削除
'_/
'_/     ※ FileNameは【フルパス】
'_/
'_/     Ver1.0    2006/1/10
'_/     Ver1.1    2006/2/5
'_/         a) prvINI_FileCreate内で、Openステートメントに指定する
'_/            ファイル番号を #1 固定からFreeFile関数利用に変更しました。
'_/     Ver1.2    2011/7/27
'_/         a) フォルダが存在しない場合に [Open Output]による
'_/            ファイル作成が失敗するバグを修正しました。
'_/            (SHCreateDirectoryEx を利用)
'_/         b) API 宣言等を 64bit対応に修正しました。
'_/
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

'==========================================
'====== API宣言 =========================
'==========================================

'INIファイルの指定したセクション内のすべてのキーと値を取得
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetPrivateProfileSection Lib "kernel32" _
                                    Alias "GetPrivateProfileSectionA" _
        (ByVal lpAppName As StringByVal lpReturnedString As String, _
         ByVal nSize As LongByVal lpFileName As StringAs Long
#Else
    Private Declare Function GetPrivateProfileSection Lib "kernel32" _
                                    Alias "GetPrivateProfileSectionA" _
        (ByVal lpAppName As StringByVal lpReturnedString As String, _
         ByVal nSize As LongByVal lpFileName As StringAs Long
#End If

'INIファイルの文字列を取得
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" _
                                    Alias "GetPrivateProfileStringA" _
        (ByVal lpApplicationName As StringByVal lpKeyName As Any, _
         ByVal lpDefault As StringByVal lpReturnedString As String, _
         ByVal nSize As LongByVal lpFileName As StringAs Long
#Else
    Private Declare Function GetPrivateProfileString Lib "kernel32" _
                                    Alias "GetPrivateProfileStringA" _
        (ByVal lpApplicationName As StringByVal lpKeyName As Any, _
         ByVal lpDefault As StringByVal lpReturnedString As String, _
         ByVal nSize As LongByVal lpFileName As StringAs Long
#End If

'INIファイルの文字列を変更
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" _
                                    Alias "WritePrivateProfileStringA" _
        (ByVal lpApplicationName As StringByVal lpKeyName As Any, _
         ByVal lpString As AnyByVal lpFileName As StringAs Long
#Else
    Private Declare Function WritePrivateProfileString Lib "kernel32" _
                                    Alias "WritePrivateProfileStringA" _
        (ByVal lpApplicationName As StringByVal lpKeyName As Any, _
         ByVal lpString As AnyByVal lpFileName As StringAs Long
#End If

'フォルダの作成
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" _
                                    Alias "SHCreateDirectoryExA" _
        (ByVal hwnd As LongPtr, ByVal pszPath As String, _
         ByVal psa As LongPtr) As Long

#Else
    Private Declare Function SHCreateDirectoryEx Lib "shell32" _
                                    Alias "SHCreateDirectoryExA" _
        (ByVal hwnd As LongByVal pszPath As String, _
         ByVal psa As LongAs Long
#End If


'==============================================
'========= INI操作関数 ======================
'==============================================

'--- Section/Key指定で値を取得 -----------------
Public Function ktINI_GetValue _
            (ByVal FileName As String, _
             ByVal SectionName As String, _
             ByVal KeyName As String, _
             ByRef ValueString As StringAs Boolean
Dim strReturnedString As String * 32767
Dim strValue As String
Dim i As Integer
Dim blnFlag As Boolean
Dim rc As Long

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

    On Error Resume Next
    rc = GetPrivateProfileString _
                (SectionName, KeyName, _
                 vbNullString, strReturnedString, _
                 Len(strReturnedString), FileName)
    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 = TrueThen    '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


'--- Section/Key指定で値の更新(追加/変更) -----------
Public Function ktINI_ReWrite _
            (ByVal FileName As String, _
             ByVal SectionName As String, _
             ByVal KeyName As String, _
             ByVal ValueString As StringAs Boolean
Dim rc As Long

    If (FileName = "") Or (SectionName = "") Or _
       (KeyName = "") Then
        ktINI_ReWrite = False
        Exit Function
    ElseIf (LCase(Right(FileName, 4)) <> ".ini") Or _
           (InStr(FileName, "\") = 0) Then
        '識別子NG,フルパス無し
        ktINI_ReWrite = False
        Exit Function
    ElseIf (Dir(FileName, vbNormal) = "") Then
        'INIファイルが無いので作成
        rc = prvINI_FileCreate(FileName)
        If (rc <> 0) Then
            'フォルダ作成に失敗
            ktINI_ReWrite = False
            Exit Function
        End If
    End If

    '既存キーならば更新、未登録キーならば追加
    On Error Resume Next
    rc = WritePrivateProfileString _
            (SectionName, KeyName, ValueString, FileName)
    On Error GoTo 0
    If (rc = 0) Then
        ktINI_ReWrite = False
    Else
        ktINI_ReWrite = True
    End If
End Function


'--- Section/Keyを削除(Keyを省略するとSection全体を削除) ---
Public Function ktINI_Delete _
            (ByVal FileName As String, _
             ByVal SectionName As String, _
             Optional ByVal KeyName As String = "") As Boolean
Dim rc As Long

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

    On Error Resume Next
    If (KeyName = "") Then
        'Sectionの削除
        rc = WritePrivateProfileString _
                (SectionName, vbNullString, _
                 vbNullString, FileName)
    Else
        'Keyの削除
        rc = WritePrivateProfileString _
                (SectionName, KeyName, _
                 vbNullString, FileName)
    End If
    On Error GoTo 0
    If (rc = 0) Then
        ktINI_Delete = False
    Else
        ktINI_Delete = True
    End If
End Function


'--- Section内の全Key/Valueを一括取得 ----------------
' KeyValueListは(キー,値)の2次元配列
Public Function ktINI_GetValueList _
            (ByVal FileName As String, _
             ByVal SectionName As String, _
             ByRef KeyValueList() As StringAs Boolean
Dim strReturnedString As String * 32767
Dim strValue As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim blnFlag As Boolean
Dim rc As Long
Dim intCount As Integer

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

    'Section全体の情報を取得
    On Error Resume Next
    rc = GetPrivateProfileSection _
            (SectionName, strReturnedString, _
             Len(strReturnedString), FileName)
    On Error GoTo 0
    If (rc = 0) Then
        ktINI_GetValueList = False
        Exit Function
    End If

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

    If (strValue = "") Then
        ktINI_GetValueList = False
        Exit Function
    End If

    '文字列から[キー:値]の2次元配列に格納
    ReDim KeyValueList(1 To intCount, 1 To 2)
    j = 1
    k = 1
    For i = 1 To Len(strValue)
        Select Case Mid(strValue, i, 1)
          Case vbNullChar
            j = j + 1
            k = 1
          Case "="
            k = 2
          Case Else
            KeyValueList(j, k) = KeyValueList(j, k) & Mid(strValue, i, 1)
        End Select
    Next i
    ktINI_GetValueList = True
End Function


'--- Section内の全Key or INIファイル内の全Sectionを一括取得 ----------------
' SecKeyListは(キー) or (セクション)の1次元配列
' SectionName を空文字にするとセクションの一覧
' SectionName を指定するとキーの一覧
Public Function ktINI_GetSecKeyList _
            (ByVal FileName As String, _
             ByVal SectionName As String, _
             ByRef SecKeyList() As StringAs Boolean
Dim strReturnedString As String * 32767
Dim strSecKey As String
Dim i As Integer
Dim j As Integer
Dim blnFlag As Boolean
Dim rc As Long
Dim intCount As Integer

    If (FileName = "") Then
        ktINI_GetSecKeyList = False
        Exit Function
    ElseIf (LCase(Right(FileName, 4)) <> ".ini") Or _
           (InStr(FileName, "\") = 0) Then
        '識別子NG,フルパス無し
        ktINI_GetSecKeyList = False
        Exit Function
    ElseIf (Dir(FileName, vbNormal) = "") Then
        'INIファイル無し
        ktINI_GetSecKeyList = False
        Exit Function
    End If

    On Error Resume Next
    If (SectionName = "") Then
        'INIファイル内のSection情報を取得
        rc = GetPrivateProfileString _
                    (vbNullString, vbNullString, _
                     vbNullString, strReturnedString, _
                     Len(strReturnedString), FileName)
    Else
        'Section内のKey情報を取得
        rc = GetPrivateProfileString _
                    (SectionName, vbNullString, _
                     vbNullString, strReturnedString, _
                     Len(strReturnedString), FileName)
    End If
    On Error GoTo 0
    If (rc = 0) Then
        ktINI_GetSecKeyList = False
        Exit Function
    End If

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

    If (strSecKey = "") Then
        ktINI_GetSecKeyList = False
        Exit Function
    End If

    '文字列から[キー] or [セクション]の1次元配列に格納
    ReDim SecKeyList(1 To intCount)
    j = 1
    For i = 1 To Len(strSecKey)
        Select Case Mid(strSecKey, i, 1)
          Case vbNullChar
            j = j + 1
          Case Else
            SecKeyList(j) = SecKeyList(j) & Mid(strSecKey, i, 1)
        End Select
    Next i
    ktINI_GetSecKeyList = True
End Function


'--- INIファイルの作成 ------------------------------
Private Function prvINI_FileCreate(ByVal FileName As StringAs Long
'0:OK, 1:既存ファイルなのでSkip, -1:Error
Dim intFileNum As Integer
Dim j As Integer
Dim strPath As String
Dim rc As Long

#If VBA7 And Win64 Then
    Const hwnd0 As LongPtr = 0
    Const psa0 As LongPtr = 0
#Else
    Const hwnd0 As Long = 0
    Const psa0 As Long = 0
#End If

'[FileName]はフルパス
    If (FileName = "") Then
        prvINI_FileCreate = -1
    ElseIf (LCase(Right(FileName, 4)) <> ".ini") Or _
           (InStr(FileName, "\") = 0) Then
        '識別子NG,フルパス無し
        prvINI_FileCreate = -1
    Else
        strPath = Left(FileName, InStrRev(FileName, "\") - 1)
        If (Dir(strPath, vbDirectory) = "") Then
            '指定フォルダが無いので作成
            rc = SHCreateDirectoryEx(hwnd0, strPath, psa0)
            If (rc <> 0) Then
                prvINI_FileCreate = -1
                Exit Function
            End If
        End If

        If (Dir(FileName, vbNormal) = "") Then
            '指定ファイルが無いので作成
            intFileNum = FreeFile
            Open FileName For Output As #intFileNum
            Close #intFileNum
            prvINI_FileCreate = 0   'OK
        Else
            prvINI_FileCreate = 1   '既存ファイル
        End If
    End If
End Function





 Home   Back Page   Next Page

ロゴ(ゴールド)   ロゴ(ゴールド)

角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2006 Allrights Reserved.