这样试试... Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 Const Seperator = "="Dim sFileName '用来保存文件名 sFileName="D:\test.txt" WriteProfileString "User name","ken su" WriteProfileString "Log in Date",Now WriteProfileString "System Status",Err.Number WriteProfileString "User name","test" Sub WriteProfileString(Section, sContent) ' 将文件定义为如下格式 Section = Content ' 注意: 请不要在数据中存在回车换行 Dim FSO Dim hFile Dim strTmp, Lines Dim SepPos Dim Found strTmp = "" Lines = "" Found = False Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sFileName) Then Set hFile = FSO.OpenTextFile(sFileName, ForReading) Do While Not hFile.AtEndOfStream
strTmp = hFile.ReadLine SepPos = InStr(1, strTmp, Seperator) If SepPos Then If UCase(Trim(Section)) = UCase(Trim(Left(strTmp, SepPos - 1))) Then strTmp = Section & "=" & sContent Found = True End If End If If Len(strTmp) Then Lines = Lines & vbCrLf & strTmp Loop hFile.Close FSO.DeleteFile sFileName End If
If Not Found Then Lines = Lines & vbCrLf & Section & "=" & sContent Set hFile = FSO.CreateTextFile(sFileName, ForWriting) hFile.Write Lines hFile.Close Set FSO=Nothing End Sub
不就行了.
如果不想追加,那你只好先读取文件内容,修改以后再使用CreateTextFile
方式(设置覆盖选项为True),然后再把修改过的内容写入。
如果用CreatTextFile,就得把以前的代码重复一遍
第二个问题,fso的文件操作有覆盖,追加的模式,如果只想更新特定内容,可以考虑先读取文件,分析并找到相应位置,修改后写回就可以了,当然这只是针对比较小的文件.
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const Seperator = "="Dim sFileName '用来保存文件名
sFileName="D:\test.txt"
WriteProfileString "User name","ken su"
WriteProfileString "Log in Date",Now
WriteProfileString "System Status",Err.Number
WriteProfileString "User name","test"
Sub WriteProfileString(Section, sContent)
' 将文件定义为如下格式 Section = Content
' 注意: 请不要在数据中存在回车换行
Dim FSO
Dim hFile
Dim strTmp, Lines
Dim SepPos
Dim Found
strTmp = ""
Lines = ""
Found = False
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sFileName) Then
Set hFile = FSO.OpenTextFile(sFileName, ForReading)
Do While Not hFile.AtEndOfStream
strTmp = hFile.ReadLine
SepPos = InStr(1, strTmp, Seperator)
If SepPos Then
If UCase(Trim(Section)) = UCase(Trim(Left(strTmp, SepPos - 1))) Then
strTmp = Section & "=" & sContent
Found = True
End If
End If
If Len(strTmp) Then Lines = Lines & vbCrLf & strTmp
Loop
hFile.Close
FSO.DeleteFile sFileName
End If
If Not Found Then Lines = Lines & vbCrLf & Section & "=" & sContent
Set hFile = FSO.CreateTextFile(sFileName, ForWriting)
hFile.Write Lines
hFile.Close
Set FSO=Nothing
End Sub