Option Explicit Private 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 pFileName 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, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long'************************************* '目的:写入数据至Ini文件
'*************************************Public Function WriteIniStr(ByVal FileName As String, ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean On Error GoTo WriteIniStrErr WriteIniStr = True If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then GoTo WriteIniStrErr Else WritePrivateProfileString AppName, In_Key, In_Data, FileName End If Exit Function WriteIniStrErr: Err.Clear WriteIniStr = False End Function '************************************* '目的:从Ini文件中读取数据
'输入: FileName 文件名 ' AppName 项目名 ' In_Key 键名
'返回: 取得给定键名上的数据
'*************************************Public Function GetIniStr(ByVal FileName As String, ByVal AppName As String, ByVal In_Key As String) As String On Error GoTo GetIniStrErr If VBA.Trim(In_Key) = "" Then GoTo GetIniStrErr End If Dim GetStr As String GetStr = VBA.String(128, 0) GetPrivateProfileString AppName, In_Key, "", GetStr, 256, FileName GetStr = VBA.Replace(GetStr, VBA.Chr(0), "") If GetStr = "" Then GoTo GetIniStrErr Else GetIniStr = GetStr GetStr = "" End If Exit Function GetIniStrErr: Err.Clear GetIniStr = "" GetStr = "" End Function'************************************* '目的:编历Ini文件中的某个主键
'输入: FileName 文件名 ' AppName 项目名 '返回:某个项目下的所有键及值
'************************************* Public Function GetInfoSection(AppName As String, FileName As String) As String() Dim strReturn As String * 32767 Dim strTmp As String Dim nStart As Integer Dim nEnd As Integer Dim i As Integer Dim sArray() As String
strTmp = strReturn i = 1 Do While strTmp <> "" nStart = nEnd + 1 nEnd = InStr(nStart, strReturn, vbNullChar) strTmp = Mid$(strReturn, nStart, nEnd - nStart) If Len(strTmp) > 0 Then ReDim Preserve sArray(1 To i) sArray(i) = strTmp i = i + 1 End If Loop GetInfoSection = sArray End Function
ini的问题有答案了,我回答读取MS SQL 的问题Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim sql As String cn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=数据库;Data Source=IP或服务名;User Id=sa;Password= sa" sql = "select * from stmp" rs.Open sql, cn, adOpenKeyset, adLockOptimistic
有个api,容易。
读取不知是什么意思。
Option Explicit
Private 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 pFileName 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, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long'*************************************
'目的:写入数据至Ini文件
'输入: FileName 文件名
' AppName 项目名
' In_Key 键名
' In_Data 键名上的数值
'返回: 写入成功 True
' 写入失败 False
'*************************************Public Function WriteIniStr(ByVal FileName As String, ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean
On Error GoTo WriteIniStrErr
WriteIniStr = True
If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then
GoTo WriteIniStrErr
Else
WritePrivateProfileString AppName, In_Key, In_Data, FileName
End If
Exit Function
WriteIniStrErr:
Err.Clear
WriteIniStr = False
End Function
'*************************************
'目的:从Ini文件中读取数据
'输入: FileName 文件名
' AppName 项目名
' In_Key 键名
'返回: 取得给定键名上的数据
'*************************************Public Function GetIniStr(ByVal FileName As String, ByVal AppName As String, ByVal In_Key As String) As String
On Error GoTo GetIniStrErr
If VBA.Trim(In_Key) = "" Then
GoTo GetIniStrErr
End If
Dim GetStr As String
GetStr = VBA.String(128, 0)
GetPrivateProfileString AppName, In_Key, "", GetStr, 256, FileName
GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
If GetStr = "" Then
GoTo GetIniStrErr
Else
GetIniStr = GetStr
GetStr = ""
End If
Exit Function
GetIniStrErr:
Err.Clear
GetIniStr = ""
GetStr = ""
End Function'*************************************
'目的:编历Ini文件中的某个主键
'输入: FileName 文件名
' AppName 项目名
'返回:某个项目下的所有键及值
'*************************************
Public Function GetInfoSection(AppName As String, FileName As String) As String()
Dim strReturn As String * 32767
Dim strTmp As String
Dim nStart As Integer
Dim nEnd As Integer
Dim i As Integer
Dim sArray() As String
Call GetPrivateProfileSection(AppName, strReturn, Len(strReturn), FileName)
strTmp = strReturn
i = 1
Do While strTmp <> ""
nStart = nEnd + 1
nEnd = InStr(nStart, strReturn, vbNullChar)
strTmp = Mid$(strReturn, nStart, nEnd - nStart)
If Len(strTmp) > 0 Then
ReDim Preserve sArray(1 To i)
sArray(i) = strTmp
i = i + 1
End If
Loop
GetInfoSection = sArray
End Function
Dim rs As New ADODB.Recordset
Dim sql As String
cn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=数据库;Data Source=IP或服务名;User Id=sa;Password= sa" sql = "select * from stmp"
rs.Open sql, cn, adOpenKeyset, adLockOptimistic
其中* 替换为从ini读取出的字段名即可