怎样实现数据的保存？

[qqx3502]

说明：Form1上1按钮Cmd1和1文本框Txt1
目标：点Cmd1显示1，再点显示2，再点显示3，……，但要求关闭程序再次打开点Cmd1要从原先的数值向上加，即点到5关闭程序，下次1打开程序Txt1显示5，点Cmd1显示6，再点显示7，……
我写的代码每次都从1开始，怎样在关闭程序时让程序保存数据呢？请大家帮忙，谢谢！！！
Dim X%
Private Sub Cmd1_Click()
X = X + 1
Txt1.Text = X
End Sub

[fvflove]

建立一个模块 复制以下代码:

'以下代码在模块中
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

'*************************************
   '目的:写入数据至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


'以下代码在窗体中
Dim X%
Private Sub Cmd1_Click()
X = X + 1
Txt1.Text = X
End Sub


Private Sub Form_Load()
  X = GetIniStr(App.Path & "\Data.ini", "Data", "Index")
  Txt1.Text = X
End Sub

Private Sub Form_Unload(Cancel As Integer)
  WriteIniStr App.Path & "\Data.ini", "Data", "Index", X
End Sub

[qqx3502]

哇噻！原来数据的存储这么复杂啊！！！
谢谢love！

[qqx3502]

还有个小问题！如果我想每次都把运行的结果自动存储到一个文本文件或是一个EXCEL文件中又怎样实现啊？

[fvflove]

上面那个就是存在一个文本文件中的.
文本文件的地址是. 你工程所在目录的一个Data.ini的文件中,你可以打看一下.
如果要存至Excel,那也一样.但是你要告诉我存到Excel那个位置?
要不,我做个示例给你看.

[jacknes009]

学习下，，，，

[qqx3502]

太好啦，请LOVE给做个Excel简单的示例吧，谢谢！！！

[fvflove]

'以下代码在窗体中
'先在C盘建立一个Xls文件
'文件名为Data.Xls 即完整文件名为"C:\Data.Xls"
'在A1单元格输入一个数值

Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object




Dim X%
Private Sub Cmd1_Click()
X = X + 1
If IsNumeric(X) Then
  Txt1.Text = X
Else
  MsgBox "Excel文件中的数据不是数值!"
End If
End Sub


Private Sub Form_Load()
  X = GetData
  Txt1.Text = X
End Sub

Private Sub Form_Unload(Cancel As Integer)
  SetData
End Sub


Private Function GetData() As String
 If Not IIf(Dir(FileName) <> "", True, False) Then
    MsgBox "未找到文件 C:\Data.Xls,请先建立文件"
    Exit Function
 End If
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.Workbooks.open("C:\Data.Xls")
Set xlSheet = xlBook.Worksheets(1) '设置活动工作表
GetData = xlSheet.Range("$A$1")
xlBook.Close (True) '关闭工作簿
xlApp.Quit '结束EXCEL对象
Set xlApp = Nothing '释放xlApp对象

End Function

Private Function SetData()
 If Not IIf(Dir(FileName) <> "", True, False) Then
    MsgBox "未找到文件 C:\Data.Xls,请先建立文件"
    Exit Function
 End If
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.Workbooks.open("C:\Data.Xls")
Set xlSheet = xlBook.Worksheets(1) '设置活动工作表
xlSheet.Range("$A$1") = X
xlBook.Close (True) '关闭工作簿
xlApp.Quit '结束EXCEL对象
Set xlApp = Nothing '释放xlApp对象

End Function

[qqx3502]

TO：LOVE
哎！奇怪啦！
关于您1楼的解决方案，我刚才试了一下提示类型不匹配(指向 X = GetIniStr(App.Path & "\Data.ini", "Data", "Index")，怎么回事啊？
新建了1个模块Moduel1，模块中代码如下：
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
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
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
窗体中代码如下：
Dim X%
Private Sub Cmd1_Click()
X = X + 1
Txt1.Text = X
End Sub


Private Sub Form_Load()
X = GetIniStr(App.Path & "\Data.ini", "Data", "Index")
Txt1.Text = X
End Sub

Private Sub Form_Unload(Cancel As Integer)
WriteIniStr App.Path & "\Data.ini", "Data", "Index", X
End Sub