Notifications
Clear all

Obter caminho da pasta dos arquivos

7 Posts
1 Usuários
0 Reactions
3,901 Visualizações
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Seguinte, sou iniciante na área de macros e há dias ando tento uma dor de cabeça com o seguinte:

Peguei um modelo de macro que consolida várias planilhas em uma só e adaptei para o que eu precisava, porém nesta planilha o caminho das planinhas a serem juntadas é fixo, tenho que digitar manualmente.

Achei um API onde é possível abrir a janela do windows solicitando que o usuário selecione o diretório, porém não consigo fazer com que a macro reconheça o caminho mostrado pelo usuário.

Ou seja, a minha variável spath tem que ser igual ao caminho selecionado pelo usuário.

spath = "caminho da janela"

Se alguem puder ajudar, agradeço.

Abraços

 
Postado : 21/11/2012 12:24 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa tarde!!

Olá seja bem vindo (a), tiagomoreira!!! Esse local é para presentação, vou mover seu tópico!!

Por favor Leia os links abaixo, obrigado!!!

Nossas Regras
viewtopic.php?f=7&t=203

Marcar Tópico como Resolvido e Agradecimento
viewtopic.php?f=7&t=3784
Lembre se de usar nossa base de dados (Pesquisa) e a Biblioteca

Como Anexar Aquivos Compactados
viewtopic.php?f=7&t=3841

Abrir Novo Tópico
viewtopic.php?f=7&t=5317
Att ;)

 
Postado : 21/11/2012 12:34 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Olá Alexandre, obrigado.

Abraço

 
Postado : 21/11/2012 1:09 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

tiago, o ideal seria colocar a rotina que está utilizando, só por :

spath = "caminho da janela"

fica dificil identificar, por enquanto de uma olhada nos topicos abaixo :

UNIR VARIAS PLANILHAS SEM LINHA DO TOTAL
viewtopic.php?f=10&t=2920&p=13208&hilit=spath#p13208

dados em uma pasta fechada
viewtopic.php?f=10&t=6165&p=32419&hilit=spath#p32419

Listar Arquivos de uma Pasta
http://www.ambienteoffice.com.br/excel/ ... _uma_pasta

[]s

 
Postado : 21/11/2012 5:00 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Mauro, segue o código, não postei no começo pois estava em outro computador.

Sub Importar_XLS()

Dim sPath As String, sName As String, fName As String
Dim r As Long, rTemp As Long
Dim shPadrao As Worksheet

'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"

Get Pasta 'Vem de um módulo

'O caminho onde as planilhas que serão lidas estao
sPath = 'resultado de Get Pasta

'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!")

End Sub
 
Postado : 21/11/2012 6:36 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

tiago, poste tambem a rotina que utiliza o "GET", verifique todas as Variáveis se estão Declaradas corretamente, você utiliza a instrução :

.DisplayAlerts = False - ela enibe as caixas de mensagens de erro, desabilite para ver se aparece onde está o erro.

Na parte abaixo, apos a instrução sPath coloque um msgbox para visualizar qual o caminho está armazenado :
Get Pasta 'Vem de um módulo

'O caminho onde as planilhas que serão lidas estao
sPath = 'resultado de Get Pasta
MsgBox sPath

Na instrução abaixo, adicione tambem um msgbox :
'O caminho + o nome do arquivo a ser aberto
fName = sPath & sName
MsgBox fName

Estou sugerindo desabilitar e utilizar os msgbox, mas você pode percorrer a rotina Passo a Passo utilizando a tecla "F8", cada vez que apertar a tecla a rotina é executada linha a linha, facilitando a visualização dos resultados.

 
Postado : 22/11/2012 1:59 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

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

 
Postado : 22/11/2012 3:43 pm