VBCommons/api/API_UserInteraction.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "API_UserInteraction"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'================ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> =========================
' Shared module version: 20220611
' Depends on:
' Required reference:
Option Explicit

Public Function ShowMessage(nMsg&, ParamArray params() As Variant)
  Call UIShowMessage(nMsg, params)
End Function

Public Function AskQuestion(nQuestion&, ParamArray params() As Variant) As Boolean
  AskQuestion = UIAskQuestion(nQuestion, params)
End Function

Public Function FollowHyperlink(oDocument As Object, sAddress$)
  Call oDocument.FollowHyperlink(sAddress)
End Function

Public Function PromptInput(sPrompt$, Optional sTitle$ = vbNullString, Optional sInitial As Variant) As String
  PromptInput = VBA.InputBox(sPrompt, sTitle, sInitial)
End Function

Public Function PromptFileFilter(sInitialPath$, sDescription$, sFilter$, _
                                  Optional sTitle$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>", _
                                  Optional bNewApplication As Boolean = False) As String
  Dim cFilters As New Collection
  Dim cDescriptions As New Collection
                      
  Call cFilters.Add("*.*")
  Call cDescriptions.Add("<22><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>")
  Call cFilters.Add(sFilter)
  Call cDescriptions.Add(sDescription)
  
  PromptFileFilter = PromptFile(sInitialPath, sTitle, cDescriptions, cFilters, bNewApplication)
End Function

Public Function PromptFile(sInitialPath$, _
                            Optional sTitle$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>", _
                            Optional cDescriptions As Collection = Nothing, _
                            Optional cFilters As Collection = Nothing, _
                            Optional bNewApplication As Boolean = False) As String
  PromptFile = vbNullString
  Dim oApplication As Object
  If Not bNewApplication Then
    Set oApplication = Application
  Else
    Set oApplication = CreateObject("Excel.Application")
    oApplication.Visible = True
  End If
  
  Dim filterCount&: filterCount = 0
  If Not cDescriptions Is Nothing And Not cFilters Is Nothing Then _
    If cDescriptions.Count = cFilters.Count Then _
      filterCount = cFilters.Count
  
  On Error Resume Next
  
  With oApplication.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = sInitialPath
    .AllowMultiSelect = False
    .ButtonName = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    .Title = sTitle
    
    Call .Filters.Clear
    If filterCount > 0 Then
      
      Dim nItem&
      For nItem = 1 To filterCount Step 1
        Call .Filters.Add(cDescriptions.Item(nItem), cFilters.Item(nItem), 1)
      Next nItem
    Else
      Call .Filters.Add("<22><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>", "*.*")
    End If
    
    Call .Show
    If .SelectedItems.Count > 0 Then _
      PromptFile = .SelectedItems(1)
  End With
  
  If bNewApplication Then _
    Call oApplication.Quit
End Function

Public Function PromptFolder(sInitialPath$, _
                              Optional sTitle$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>", _
                              Optional bNewApplication As Boolean = False) As String
  PromptFolder = vbNullString
  Dim oApplication As Object
  If Not bNewApplication Then
    Set oApplication = Application
  Else
    Set oApplication = CreateObject("Excel.Application")
    oApplication.Visible = True
  End If
  
  On Error Resume Next
  With oApplication.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = sInitialPath
    .AllowMultiSelect = False
    .ButtonName = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    .Title = sTitle
    
    Call .Show
    
    If .SelectedItems.Count > 0 Then _
      PromptFolder = .SelectedItems(1)
  End With
  
  If bNewApplication Then _
    Call oApplication.Quit
End Function