获取打开对话框的路径函数

小函数几则.

'获取打开路径函数
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