Mauro, resolvi meu problema graças a sua dica de usar a MsgBox.
Ao executar a macro GetPasta, não era retornado nenhum caminho, então fiz o seguinte, juntei tudo na mesma macro. Ficou meio confuso e grande, mas funcionou. Estou postando pois pode ser útil a alguém posteriormente.
Muito Obrigado.
Abraço
'Declarações API para funcionar localização da pasta
#If VBA7 Then
Private Type BROWSEINFO
hOwner As LongPtr
pidlRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As LongPtr
lpfn As LongPtr
lParam As LongPtr
iImage As Long
End Type
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As LongPtr
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
#Else
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
#End If
Private Const BIF_RETURNONLYFSDIRS = &H1
Sub Importar_XLS_SPP()
Dim sPath As String, sName As String, fName As String
Dim r As LongPtr, rTemp As LongPtr
Dim shPadrao As Worksheet
Dim bnfo As BROWSEINFO
Dim sCaminho As String
Dim lÍndice As LongPtr
Dim vJanela As Variant
Dim iPosição As Integer
Dim sPasta As String
'Para a macro executar mais rápido!
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
'A planilha onde serão colados os dados
Set shPadrao = Sheets(1)
'Renomear aba
Sheets(1).Name = "SPP"
'O caminho onde as planilhas que serão lidas estao
'A pasta raiz é o Desktop:
bnfo.pidlRoot = 0&
'Título
bnfo.lpszTitle = "Selecione uma Pasta:"
'Tipo de dado retornado:
bnfo.ulFlags = &H1
'Mostra a janela:
vJanela = SHBrowseForFolder(bnfo)
'Analisa e trata o resultado:
sCaminho = Space(512)
lÍndice = SHGetPathFromIDList(ByVal vJanela, ByVal sCaminho)
If lÍndice Then
iPosição = InStr(sCaminho, Chr(0))
sPasta = Left(sCaminho, iPosição - 1)
Debug.Print sPasta
Else
'Nenhuma Pasta foi selecionada
End If
sPath = sPasta & ""
MsgBox sPath
'Descubro o nome do primeiro arquivo a ser aberto
sName = Dir(sPath & "*.xl*")
'Faço o loop que le todos os arquivos
Do While sName <> ""
'Acha a ultima linha utilizada na planilha onde serao colados os dados
r = shPadrao.Cells(Rows.Count, "E").End(xlUp).Row
'O caminho + o nome do arquivo a ser aberto
fName = sPath & sName
'Abro o workbook a ser lido
Workbooks.Open Filename:=fName, UpdateLinks:=False
'Descubro sua quantas linhas ele possui
rTemp = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
'Colo na planilha principal
ActiveWorkbook.ActiveSheet.Range("A2:AO" & rTemp).Copy shPadrao.Range("A" & r + 1)
'Fecho o arquivo já lido
ActiveWorkbook.Close SaveChanges:=False
ScapeB:
'Atualizo a variavel com funcao DIR() que acha o proximo arquivo nao processado
sName = Dir()
Loop
On Error GoTo 0
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
MsgBox ("Compilação completada com sucesso!"), (vbInformation), ("Pronto!")
Set CaixaDialogo = Application.FileDialog(msoFileDialogSaveAs)
With CaixaDialogo
.Show
.Execute
End With
End Sub
Private Sub Workbook_Open()
Importar_XLS_SPP
End Sub
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 22/11/2012 3:43 pm