VBA及VB6写入读取修改ini配置文件教程

f8b1987 · 发表于 2024-3-4 10:30

本帖最后由 f8b1987 于 2024-3-4 10:33 编辑

最近刚好用到这方面代码，进行了资料收集、整理。

本文所有代码见附件：

VBA读取写入修改ini文件.zip (18.61 KB, 下载次数: 51)

前言：
ini文件内容结构
   .ini 文件是Initialization File的缩写，windows的系统配置文件所采用的存储格式。据我所知，XP及更高版本系统均可使用ini文件读写改。

   .ini配置文件的后缀也可以是”.cfg“、“.conf”或者是“.txt”，读取、写入、修改的代码方法一样。

   .ini、.cfg、.conf、.txt等文件，可以用记事本直接打开、修改，也可以手工用记事本创建。

   如果手工创建txt,存储涉及中文内容的，请选择编码为ANSI保存，新系统默认的txt为UTF-8编码；本教程代码创建的txt则无需额外设置。

   ini配置文件由节、键、值组成。

   如下图，[往来单位]、[部门]是节，文件01路径、业务部在等号左边是键，等号右边的是值。

与VBA代码类似，ini文件也可以添加注释，用分号（;)在前表示从这里开始到行结束为注释文字）

ini文件用途
主要是默认一些配置参数。例如窗体程序需要选择某个文件、勾选某个参数，如果想记住上次的设置，减少重复操作，可以将配置记录在ini文件中，下次读取文件中的参数配置进行默认设置即可。

一、处理ini文件的API调用
VBA创建模块，添加代码（兼容64位office处理）
提示：
如果只是创建，可以调用记事本生成，无需API；读取所有内容也无需API；指定节、键读取、修改、添加时，使用API处理则会方便。
(论坛原因,API代码会被隐藏)

<blockquote>#If VBA7 Then

复制代码

二、创建、写入ini文件

Sub 写入及修改ini文件()
Dim write1 As Long
'参数一： Section Name (节的名称)。
'参数二：节下面的项目名称。
'参数三：项目的内容。
'参数四： ini配置文件的路径名称。
'文件不存在时，会新增ini文件，写入内容；
'当文件存在时：参数2存在时，参数3不同值会变成修改；参数2不存在，则在相应【节】块后面添加一行项目、值
write1 = WritePrivateProfileString("往来单位", "文件01路径", "D:\客户资料.xlsx", ThisWorkbook.Path & "\我的默认配置.ini")
write1 = WritePrivateProfileString("往来单位", "文件02路径", "D:\供应商资料.xlsx", ThisWorkbook.Path & "\我的默认配置.ini")
write1 = WritePrivateProfileString("部门", "业务部", "TRUE", ThisWorkbook.Path & "\我的默认配置.ini")
write1 = WritePrivateProfileString("部门", "采购部", "FALSE", ThisWorkbook.Path & "\我的默认配置.ini")
End Sub

复制代码

添加注释内容，可以在第三参数添加分号，例如

write1 = WritePrivateProfileString("往来单位", "文件01路径", "D:\客户资料.xlsx;新增注释", ThisWorkbook.Path & "\我的默认配置.ini")

复制代码

如果要在行首先写入注释，则先创建ini文件，写入注释，再写入节、键、值

Sub 写入及修改ini文件2()
Dim iniFilePath As String
iniFilePath = ThisWorkbook.Path & "\我的默认配置.ini" ' INI 文件路径，请根据实际情况修改
Dim fileNum As Integer
fileNum = FreeFile
Open iniFilePath For Output As fileNum ' 打开 INI 文件以供写入
' 写入注释到第一行
Print #fileNum, "; 这是一个示例的注释"
Close fileNum ' 关闭文件
' 写入设置到 INI 文件
write1 = WritePrivateProfileString("往来单位", "文件01路径", "D:\客户资料.xlsx", iniFilePath)
MsgBox "INI 文件内容已成功写入。"
End Sub

复制代码

三、读取ini内容

代码1，读取所有内容

Sub 读取INI文件所有内容到Excel()
Dim iniFilePath As String
iniFilePath = ThisWorkbook.Path & "\我的默认配置.ini" ' INI 文件路径，请根据实际情况修改
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1) ' 在当前工作簿中创建新工作表
Dim fileNum As Integer
Dim lineText As String
Dim rowNum As Integer
fileNum = FreeFile
Open iniFilePath For Input As fileNum ' 打开 INI 文件以供读取
rowNum = 1
Do Until EOF(fileNum)
Line Input #fileNum, lineText ' 逐行读取 INI 文件内容
ws.Cells(rowNum, 1).Value = lineText ' 将每行内容写入 Excel 工作表第一列
rowNum = rowNum + 1
Loop
Close fileNum ' 关闭文件
End Sub

复制代码

代码2，读取所有内容

Sub fso读取ini文件所有内容()
Dim filePath As String
Dim fso As Object
Dim ts As Object
Dim fileContent As String
Dim i As Integer
Dim arr As Variant
' 读取txt源代码文件路径
filePath = ThisWorkbook.Path & "\我的默认配置.ini"
' 创建文件系统对象
Set fso = CreateObject("Scripting.FileSystemObject")
' 打开文件
Set ts = fso.OpenTextFile(filePath)
' 读取文件内容
fileContent = ts.ReadAll
' 关闭文件
ts.Close
' 将文件内容分割成行
arr = Split(fileContent, vbCrLf)
For i = 0 To UBound(arr)
Cells(i + 1, "B") = arr(i)
Next i
End Sub

复制代码

代码3，读取指定项目内容，免循环判断

Sub 读取ini指定项目()
Dim read_OK1 As Long, read_OK2 As Long
Dim read1 As String, read2 As String
' 初始化 read1 字符串为 256 个字符的空字符串
read1 = String(255, 0)
'若.ini文件中项目无内容，则采用参数3的值，如果你在ini路径名称写错了，也读不出内容，也是会参数3的值。
' 从 INI 文件中读取指定节（"往来单位"）下的指定键（"文件02路径"）的值
' 如果未找到指定的节或键，则返回空字符串
' 参数说明：第一个参数为节名，第二个参数为键名，第三个参数为默认值（如果未找到键则返回默认值）
' 第四个参数为接收读取结果的字符串变量，第五个参数为字符串变量的长度，第六个参数为 INI 文件路径
read_OK1 = GetPrivateProfileString("往来单位", "文件02路径", "", read1, 256, ThisWorkbook.Path & "\我的默认配置.ini")
read2 = String(255, 0)
read_OK2 = GetPrivateProfileString("职员", "经理", "不存在", read2, 256, ThisWorkbook.Path & "\我的默认配置.ini")
[A1] = read1
'截取 read1 中第一个 null 字符前的内容，去掉尾部乱码。如果写入表格，默认不会有乱码，直接在VBA内处理字符串时则需去掉
read1 = Left(read1, InStr(read1, Chr(0)) - 1)
read2 = Left(read2, InStr(read2, Chr(0)) - 1)
MsgBox read1 & Chr(10) & read2
End Sub

复制代码

四、修改ini内容

同样采取写入的方式，如果文件或节、键不存在，则新增；
如果文件存在，节存在，项目不存在，则增加项目；
如果文件存在，节存在，项目存在，值不一样，则修改值；

Sub 修改ini文件()
Dim write1 As Long
write1 = WritePrivateProfileString("往来单位", "文件01路径", "D:\客户资料-123.xlsx", ThisWorkbook.Path & "\我的默认配置.ini")
write1 = WritePrivateProfileString("往来单位", "文件03路径", "D:\供应商资料-456.xlsx", ThisWorkbook.Path & "\我的默认配置.ini")
write1 = WritePrivateProfileString("职员", "经理", "张三", ThisWorkbook.Path & "\我的默认配置.ini")
End Sub

复制代码

如果你有更好的代码，欢迎补充完善。

leolee82 · 发表于 2024-3-4 12:10

感谢分享。我也是用的API，看了你的代码，我觉得直接读取所有内容，再解析到嵌套字典中也不错，效率也高。
先记录下，等闲了写一下。

opiona · 发表于 2024-3-4 12:19

定义为函数日后调用更方便

Rem 当VBA7和Win64都是True时(只有64的Excel才是这种情况)，使用第一条Declare语句。在其他版本中，使用第二条Declare语句
Rem =====================================================================================================================
#If Vba7 And Win64 Then
Private 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
Private Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA"(ByVal lpApplicationName As String,ByVal lpKeyName AsAny,ByVal lpString As Any,ByVal lpFileName As String) As Long
#Else
Rem 32位的：注意64位系统，安装的Excel可能是32位的Excel VBA
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVallpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByRef lpReturnedString() As Byte, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
#End If
Sub Main()
Dim StrIniFile, StrSection, StrKey, StrValue As String
StrIniFile = ThisWorkbook.Path & "\canshu.ini"
StrSection = "信息设置"
StrKey = "用户名"
StrValue = "特朗普"
Dim L As Long
L = WriteIni(StrIniFile, StrSection, StrKey, StrValue)
StrValue = ReadIni(StrIniFile, StrSection, StrKey, "")
MsgBox "用户名= " & StrValue, vbInformation
End Sub
Rem ********************************************************************
Rem ReadIni 读INI文件，段落中某关键字的值
Rem 参数：IniFile Ini文件路径
Rem 参数：Section ini文件中的段落 [信息设置]
Rem 参数：Key ini文件的关键字用户名=特朗普
Rem 参数：Value ini文件中的值，读时取空值
Rem StrValue = ReadIni(StrIniFile, StrSection, StrKey, "")
Rem ********************************************************************
Public Function ReadIni(ByVal IniFile As String, ByVal Section As String, ByVal Key As String, ByVal Value As String) As String
Dim strRtn As String '//Dim strRtn As String * 5000
strRtn = Space(5000)
Dim lngRtn As Long
lngRtn = GetPrivateProfileString(Section, Key, Value, strRtn, 4999, IniFile)
If lngRtn > 0 Then
strRtn = Trim(strRtn)
ReadIni = Mid(strRtn, 1, Len(strRtn) - 1)
Else
ReadIni = DefaultValue
End If
End Function
Rem ********************************************************************
Rem WriteIni 写INI文件，段落中某关键字的值
Rem 参数：IniFile Ini文件路径
Rem 参数：Section ini文件中的段落 [信息设置]
Rem 参数：Key ini文件的关键字用户名=特朗普
Rem 参数：Value ini文件中的值，输入时取空值
Rem Dim L As Long
Rem L = WriteIni(StrIniFile, StrSection, StrKey, StrValue)
Rem ********************************************************************
Public Function WriteIni(ByVal IniFile As String, ByVal Section As String, ByVal Key As String, ByVal Value As String) As Long
Dim lngRtn As Long
lngRtn = WritePrivateProfileString(Section, Key, Value, IniFile)
If lngRtn > 0 Then
Else
Call Err.Raise(-1, "IniFileUtil.WriteIntoIni", "Failed to write")
End If
WriteIni = lngRtn
End Function

复制代码

伶俐的毛豆 · 发表于 2024-3-5 09:36

非常好的文章，留個記號

gaolzhen · 发表于 2024-3-5 09:54

好东西，谢谢分享！！！！

		自动登录	找回密码
密码			免费注册

[原创] VBA及VB6写入读取修改ini配置文件教程

评分

评分