[Resolvido]Incluir caminho do arquivo Excel em uma variável.

Prezados,

Tenho este código que faz a importação de um ficheiro Excel para dentro de uma tabela, porém, antes que dessa importação acontecer eu trato o arquivo com o vba em vermelho abaixo:

Gostaria de adaptar este código para capturar o nome do ficheiro e lançar aonde está grifado em azul para não ter a necessidade de colocar sempre o caminho absoluto do arquivo.

Alguém poderia me dar uma dica por gentileza?

Grato,

Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim CaminhoDoFicheiro As String
Dim JanelaDeProcura As Office.FileDialog
Dim MeusFiltros As Office.FileDialogFilter
Dim blnHasFieldNames As Boolean
blnHasFieldNames = True
   
'--------------------------------Altera excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object

    Set oExcel = CreateObject("Excel.Application")
    Set oBook = oExcel.Workbooks.Open(Application.CurrentProject.Path & "\Demonstrativo de Pagamento\Demonstrativo_analise_10420070.xlsx")
    oExcel.Visible = False

    Set oSheet = oBook.Worksheets(1)
    oSheet.Range("A1:AD3").Delete
    oSheet.Range("A1:A4000").Delete
    'Substitui campos pela nome da tabela
    oSheet.Range("A1:X1").Value = ""
    oSheet.Range("A1").Value = "Campo1"
    oSheet.Range("B1").Value = "Campo2"
    oSheet.Range("C1").Value = "Campo3"
    oSheet.Range("D1").Value = "Campo4"
    oSheet.Range("E1").Value = "Campo5"
    oSheet.Range("F1").Value = "Campo6"
    oSheet.Range("G1").Value = "Campo7"
    oSheet.Range("H1").Value = "Campo8"
    oSheet.Range("I1").Value = "Campo9"
    oSheet.Range("J1").Value = "Campo10"
    oSheet.Range("K1").Value = "Campo11"
    oSheet.Range("L1").Value = "Campo12"
    oSheet.Range("M1").Value = "Campo13"
    oSheet.Range("N1").Value = "Campo14"
    oSheet.Range("O1").Value = "Campo15"
    oSheet.Range("P1").Value = "Campo16"
    oSheet.Range("Q1").Value = "Campo17"
    oSheet.Range("R1").Value = "Campo18"
    oSheet.Range("S1").Value = "Campo19"
    oSheet.Range("T1").Value = "Campo20"
    oSheet.Range("U1").Value = "Campo21"
    oSheet.Range("V1").Value = "Campo22"
    oSheet.Range("W1").Value = "Campo23"
    oSheet.Range("X1").Value = "Campo24"
   oBook.Save
   oBook.Close
   oExcel.Quit
'-------------------------------Altera excel

strPath = CurrentProject.Path & "\Demonstrativo de Pagamento\" & InitialFileName ' drive onde se situa o seu documento excel
strTable = "tblAmil" 'nome da tabela no seu banco que recebera os dados

Set JanelaDeProcura = Application.FileDialog(msoFileDialogFilePicker)

With JanelaDeProcura
.Title = "Selecione o arquivo"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"

.FilterIndex = 2

.ButtonName = "Selecione"
.InitialView = msoFileDialogViewDetails
.InitialFileName = CurrentProject.Path & "\Demonstrativo de Pagamento\" & InitialFileName
If .Show = -1 Then
CaminhoDoFicheiro = CStr(JanelaDeProcura.SelectedItems.Item(1))
Else
Exit Sub
End If
Debug.Print Mid([CaminhoDoFicheiro], InStrRev([CaminhoDoFicheiro], "\") + 1)
CaminhoDoFicheiro = Mid([CaminhoDoFicheiro], InStrRev([CaminhoDoFicheiro], "\") + 1)
End With

strFile = Dir(strPath & CaminhoDoFicheiro)

Do While Len(strFile) > 0
strPathFile = strPath & strFile

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames
strFile = Dir()
DoCmd.RunSQL "UPDATE tblAmil SET Campo24 = '" & Me.cboConvenio & "'"
Loop

'----------------------

'Seta registros na tabela Recebido
CurrentDb.Execute "INSERT INTO Recebido (senhaAutorizacao, numeroCarteira, nomeBeneficiario, dataHoraInternacao, codigo, descricao, quantidade, valorUnitario, valorTotal, Convenio)" & vbCrLf & _
"SELECT tblAmil.Campo7, tblAmil.Campo9, tblAmil.Campo10, tblAmil.Campo11, tblAmil.Campo13, tblAmil.Campo14, tblAmil.Campo18, tblAmil.Campo20, tblAmil.Campo20, tblAmil.Campo24" & vbCrLf & _
"FROM tblAmil;"

CurrentDb.Execute "DELETE * FROM tblAmil"

MsgBox "Demonstrativo de pagamento importado com sucesso!", vbInformation, "Importar Registros"
DoCmd.OpenForm "frmDtCredito"

Else

MsgBox "USUÁRIO ATUAL NÃO TEM PERMISSÃO PARA ALTERAR AS CONFIGURAÇÕES DE ACESSO!", vbCritical, "Aviso"

End If

Up.

Deixo um pequeno exemplo com a duvida que tenho.

Extrair na área de trabalho.

'No VBA abaixo, tenho sempre que informar o nome do arquivo, quando na verdade ele deveria ser guardado e uma variável para usar
essa variável que capturou o nome do ficheiro.

Set oBook = oExcel.Workbooks.Open(Application.CurrentProject.Path & "\Amil_Demonstrativo_analise_10420070_1_082015.xlsx")

https://www.dropbox.com/s/yowd7fkk7tmf5y7/Teste.rar?dl=0

Prezados,

Consegui resolver a questão colocada anteriormente.

Deixo código completo caso algum utilizador do fórum tenho o mesmo problema.