VBA - Filtrar as opções de seleção de pasta para aparecer somente as que iniciam com o valor da célula

Boa tarde,

A minha dificuldade está sendo filtrar para que apareça apenas durante a seleção apenas as pastas que começam com aquela data, que no caso está concatenada em uma celula A2 na planilha Plan1.

Exemplo: na pasta tem como nome a data e dia concatenados: 20180312220100. Eu desejo digitar 12/03/2018 em um campo e me retornar como opções para selecionar todas as pastas que comecem com 20180312.




O meu programa em si tem como objetivo selecionar a pasta de interesse e fazer com que todos os seus arquivos sejam enviados às suas respectivas pastas. No geral, ele está rodando como eu desejo. Como são muitas pastas, eu tenho que filtrar para que apareçam como opções somentes as que são referentes ao dia que desejo.

Agradeceria se alguem pudesse me ajudar com isso.


Segue abaixo o que tenho agora do código:


Sub Copiar_arquivos()
Dim FSO
Dim data As String
Dim fName As String, fromPath As String, toPath As String
Dim toSubPath As String, Cnt As Long
On Error Resume Next

Dim fldr As FileDialog
   Dim sItem As String
   Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
   With fldr
       .Title = "Escolha uma pasta"
       .AllowMultiSelect = False
       .InitialFileName = "C:\Users\leir.paiva\Desktop\teste1"  'pasta inicial
       If .Show <> -1 Then GoTo NextCode
       sItem = .SelectedItems(1)
   End With
NextCode:
  Set fldr = Nothing

fromPath = sItem 'pasta inicial
toPath = "C:\Users\leir.paiva\Desktop\teste2" 'pasta final


Set FSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If Not FSO.FolderExists(fromPath) Then
MsgBox fromPath & " caminho invalido.", vbInformation, "Erro"
ElseIf Not FSO.FolderExists(toPath) Then
MsgBox toPath & " caminho invalido.", vbInformation, "Erro"
Else
FSO.CopyFile Source:=fromPath & "\*oi*", Destination:="C:\Users\leir.paiva\Desktop\teste2\oi" 'copiar para o destino de acordo com o filtro
FSO.CopyFile Source:=fromPath & "\*hg*", Destination:="C:\Users\leir.paiva\Desktop\teste2\hg"
End If
If Err.Number = 53 Then MsgBox "não encontrado."



End Sub

Tópico movido para Off-topic

Fórum exclusivo de Ms Access, a sua duvida é claramente Excel.