[Resolvido]Exportar para Excel e nome da pesquisa

Olá.
Tenho uma BD com um formulário pesquisa como apresentei em tópico:
https://www.maximoaccess.com/t25865-resolvidochamar-funcao-ignorar-acentos

Em pesquisa tenho um botão para exportar para Excel os dados da caixa de listagem resultante da pesquisa feita:

Private Sub exporta_lista_Click()
Dim q As QueryDef
Set q = CurrentDb.QueryDefs("Lista")                'Lista é consulta"
q.SQL = Me.lista_especialidade.RowSource               'lista_especialidade é minha caixa de listagem
q.Close
Set q = Nothing
DoCmd.OutputTo acOutputQuery, "Lista", "MicrosoftExcel Workbook (*.xlsx)", "", True, "", 0
End Sub

O que pretendia é que ao exportar para Excel este não tivesse o nome Lista, mas o nome inserido no campo ou item especialidade.
Exemplo: pesquiso madeira ou mad, ao exportar o Excel, em vez de Lista, aparecesse madeira ou mad.
É possível criar um código para isto acontecer?
Obrigado.

Teste;

Código:

Private Sub exporta_lista_Click()
Dim q As QueryDef
Set q = CurrentDb.QueryDefs("Lista")                'Lista é consulta"
q.SQL = Me.lista_especialidade.RowSource              'lista_especialidade é minha caixa de listagem
q.Close
Set q = Nothing
Call DoCmd.TransferSpreadsheet(TransferType:=acExport, TableName:="Lista", FileName:=CurrentProject.Path & "\" & Me.SeuCampoEspecialidade & ".xlsx")
End Sub

Alterei o código assim:

Private Sub exporta_lista_Click()
Dim Ok As Integer, entpesquisa_especialidadeTruncado As Integer, cadTítulo As String, entCuadroMensaje As Integer
On Error GoTo 1

Dim q As QueryDef
Set q = CurrentDb.QueryDefs("Lista")       'Lista é consulta
q.SQL = Me.lista_especialidade.RowSource   'lista_especialidade é caixa de listagem
q.Close
Set q = Nothing
Call DoCmd.TransferSpreadsheet(TransferType:=acExport, TableName:="Lista", FileName:=CurrentProject.Path & "\" & Me.pesquisa_especialidade & ".xlsx")
1:
If Err.Number = 2501 Then
     Err.Number = 0
     Exit Sub
  Else
     entCuadroMensaje = vbOKOnly + vbInformation + vbDefaultButton1
     Ok = MsgBox("Excel exportado", entCuadroMensaje, cadTítulo)
     Exit Sub
  End If
 
End Sub

Deu certo.
Exporta imediatamente aparecendo o aviso Excel exportado com o nome dado na pesquisa.
Dá para pedir exportar onde?

Faça o teste;

Não esqueça de habilitar a referencia VBA Microsoft Office XX.0 Object Library, XX.0 é a versão do seu access;

Código:

Private Sub exporta_lista_Click()
'Requer a referencia VBA Microsoft Office XX.0 Object Library
Dim Ok As Integer
Dim entpesquisa_especialidadeTruncado As Integer
Dim cadTítulo$
Dim entCuadroMensaje As Integer
Dim fd As FileDialog
Dim FolderName$
Dim strCaminho$
On Error GoTo 1

Dim q As QueryDef
Set q = CurrentDb.QueryDefs("Lista")      'Lista é consulta
q.SQL = Me.lista_especialidade.RowSource  'lista_especialidade é caixa de listagem
q.Close
Set q = Nothing

 Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  If fd.Show = True Then
    If fd.SelectedItems(1) <> vbNullString Then
        FolderName = fd.SelectedItems(1)
        strCaminho = FolderName
Call DoCmd.TransferSpreadsheet(TransferType:=acExport, TableName:="Lista", FileName:=strCaminho & "\" & Me.pesquisa_especialidade & ".xlsx")
 End If
Else
    Exit Sub
End If
 
Exit Sub
Set fd = Nothing
1:
If Err.Number = 2501 Then
    Err.Number = 0
    Exit Sub
  Else
    entCuadroMensaje = vbOKOnly + vbInformation + vbDefaultButton1
    Ok = MsgBox("Excel exportado", entCuadroMensaje, cadTítulo)
    Exit Sub
  End If
End Sub

Deu certo.
Tem que se selecionar a pasta e guarda segundo o nome dado na pesquisa.
Obrigado, amigo. Abraço.

Isso mesmo;

Fico feliz.

Obrigado pelo retorno o forum agradece.