小函数几则.
'获取打开路径函数
Private Function GetXlsDir(ByVal OpenPath As String) As String
Dim TmpStr As String
Dim tmpLen As Integer
Dim j As Integer
Dim Pos As Integer
OpenPath = Trim(OpenPath)
If OpenPath = "" Then
GetXlsDir = App.Path & "/Excel/"
Exit Function
End If
tmpLen = Len(OpenPath)
For j = 1 To tmpLen
TmpStr = Mid(OpenPath, j, 1) & TmpStr
Next
Pos = InStr(1, TmpStr, "/")
OpenPath = Mid(OpenPath, 1, tmpLen - Pos)
GetXlsDir = OpenPath
End Function
'写TXT文件
'参数:wFile为写入文件的路径和文件名,wStr为要写入的文件内容
Public Function WriteSetupInfo(ByVal wFile As String, ByVal wStr As String) As Boolean
WriteSetupInfo = False
On Error GoTo wser
Dim fs, c
Set fs = CreateObject("Scripting.FileSystemObject")
Set c = fs.CreateTextFile(wFile, True)
c.Write (wStr)
c.Close
Set c = Nothing
WriteSetupInfo = True
Exit Function
wser:
WriteSetupInfo = False
End Function
'读取TXT文件
'参数:rFile为要读取文件的路径和文件名
Public Function GetSetupInfo(ByVal rFile As String) As String
GetSetupInfo = ""
On Error GoTo gser
Open rFile For Binary As #1
GetSetupInfo = Input(LOF(1), 1)
Close 1
Exit Function
gser:
GetSetupInfo = ""
End Function
调用示例:
Private Sub cmdCmddlg_Click()
'获取上次打开的路径
Dim gPath As String
gPath = GetSetupInfo(App.Path & "/Excel/path.txt")
If gPath = "" Then
CommonDialog1.InitDir = App.Path & "/Excel/"
Else
CommonDialog1.InitDir = gPath
End If
CommonDialog1.ShowOpen
On Error GoTo ErrHandle
If Len(Trim(CommonDialog1.FileName)) > 0 Then
txtImportFileName = Trim(CommonDialog1.FileName)
'保存上次打开的路径
WriteSetupInfo App.Path & "/Excel/path.txt", GetXlsDir(Trim(CommonDialog1.FileName))
End If
Exit Sub
ErrHandle:
End Sub