Изменить заголовок по умолчанию для метки с MS Access VBA - PullRequest
0 голосов
/ 16 мая 2019

У меня есть метка в главной форме MS Access, которая должна отображать место сохранения файла экспорта. У меня есть кнопка [Редактировать], которая при нажатии вызывает диалоговое окно файла и позволяет пользователю выбрать папку для экспорта. Как только папка выбрана, заголовок метки меняется на местоположение папки, выбранной пользователем. Это работает отлично. Моя единственная проблема заключается в том, что при закрытии и повторном открытии БД заголовок метки возвращается к исходному заголовку (в данном случае, скажем, просто говорится ТЕСТ). Мне бы хотелось, чтобы при изменении заголовка надписи он оставался таким, пока пользователь не нажмет кнопку [Редактировать] и снова не изменит местоположение. Ниже приведен код VBA, который я использую.

Заранее благодарю за помощь!

Sub SetFileLocation()
    Dim Ret

    strUserName = Environ("UserName")

    strPath = "C:\documents and settings\" & strUserName & "\Desktop"


    '~~> Specify your start folder here
    Ret = BrowseForFolder(strPath)

    Forms.frmmainform.lblFolderLocation.Caption = strFolderLocation



End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level

    Dim ShellApp As Object

     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)



     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
Debug.Print BrowseForFolder
strFolderLocation = BrowseForFolder
Debug.Print strFolderLocation
     'Destroy the Shell Application
    Set ShellApp = Nothing

     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function

Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

1 Ответ

1 голос
/ 17 мая 2019

Хотя лучшим способом является сохранение значения в некоторой таблице, вы можете сохранить предыдущее значение в свойстве пользовательской формы. Сначала создайте свойство формы (в ближайшем окне):

CurrentProject.AllForms ("Your form name").Properties.Add "LastFolder", ""

Затем сохраните его в своей сабы вот так

...
Me.lblFolderLocation.Caption = strFolderLocation
CurrentProject.AllForms("Your form name").Properties("LastFolder").Value = strFolderLocation

Затем восстановите последнее значение в событии Load:

Private Sub Form_Load()
    Me.lblFolderLocation.Caption  = CurrentProject.AllForms("Your form name").Properties("LastFolder")
End Sub

...