importar arquivo de imagens e listar  [Resolvido]

Visual Basic for Aplication e macros no Excel.
Regras do fórum
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde. Imagem

importar arquivo de imagens e listar

Mensagempor valzito » Sex Jan 17, 2020 5:31 pm

Salve senhores,

Tenho um sisteminha que carrega imagens da planilha com base no Nome e endereço completo da imagem para um userform. Até aqui tudo bem, funcionando tudo ok.
O problema é que tenho uma pasta que tem algumas centenas de imagens que preciso inserir no sistema. Como são muitas, Preciso criar uma macro que me permita baixar todas, em vez de uma a uma.

Esse código que Encontrei na internet faz parte do que preciso, busca o Arquivo e baixa, só que tem dois problemas: Não pega o endereço completo, apenas o nome da imagem, e o outro é que vc precisa clicar na célula onde vai iniciar o primeiro nome. No meu caso seria: NOME DA IMAGEM Iniciar na célula (B2), ENDEREÇO COMPLETO DA IMAGEM na (C2).

Gostaria de saber se é possível adapta esse código para realizar essa façanha :)

Desde já agradeço!

Código: Selecionar todos
Option Explicit
Sub GetFileNames()
Dim xRow As Long
Dim xDirect, xFname, InitialFoldr

InitialFoldr = "C:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = " Selecione o Aquivo "
.InitialFileName = InitialFoldr
.Show
   
If .SelectedItems.Count <> 0 Then
xDirect = .SelectedItems(1) & "\"
xFname = Dir(xDirect, 7)
Do While xFname <> ""
ActiveCell.Offset(xRow) = xFname
xRow = xRow + 1
xFname = Dir
Loop
End If
End With
End Sub
valzito
Membro
Membro
 
Mensagens: 46
Registrado em: Sáb Mar 23, 2019 2:58 am
Has thanked: 33 times
Have thanks: 3 times

{ SO_SELECT }

Re: importar arquivo de imagens e listar

Mensagempor valzito » Dom Jan 19, 2020 1:23 pm

Boa tarde,

Depois de muitas pesquisas, consegui chegar a esse Código no forum do Clube do hardware que faz tal feito.

Código: Selecionar todos
Option Explicit
Sub GetFileNames()
Dim rowB As Long: rowB = 2
Dim rowC As Long: rowC = 2
Dim xDirect, xFname, InitialFoldr

InitialFoldr = "C:\"
With Excel.Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Excel.Application.DefaultFilePath & "\"
.Title = " Selecione o Aquivo "
.InitialFileName = InitialFoldr
.Show
   
If .SelectedItems.Count <> 0 Then
xDirect = .SelectedItems(1) & "\"
xFname = VBA.Dir(xDirect, 7)
Do While xFname <> ""
Range("B" & rowB) = xFname
Range("C" & rowC) = xDirect
rowB = rowB + 1
rowC = rowC + 1
xFname = VBA.Dir
Loop
End If
End With
End Sub


O problema é que o código lista também o nome da extensão do arquivo. Como o nome da imagem que está na pasta surgirá na barra do formulário do meu sistema, não fica bem aparecer o nome da extensão, certo?
Gostaria de sabe se tem como adaptar o código para que o nome da imagem surja sem o nome da extensão.

Abç
valzito
Membro
Membro
 
Mensagens: 46
Registrado em: Sáb Mar 23, 2019 2:58 am
Has thanked: 33 times
Have thanks: 3 times

Re: importar arquivo de imagens e listar  [Resolvido]

Mensagempor klarc28 » Seg Jan 20, 2020 6:52 am

Código: Selecionar todos
Option Explicit
Sub GetFileNames()
Dim rowB As Long: rowB = 2
Dim rowC As Long: rowC = 2
Dim xDirect, xFname, InitialFoldr

InitialFoldr = "C:\"
With Excel.Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Excel.Application.DefaultFilePath & "\"
.Title = " Selecione o Aquivo "
.InitialFileName = InitialFoldr
.Show
   
If .SelectedItems.Count <> 0 Then
xDirect = .SelectedItems(1) & "\"
xFname = VBA.Dir(xDirect, 7)
Do While xFname <> ""
If InStr(xFname, ".") > 0 Then
   xFname = Left(xFname, InStr(xFname, ".") - 1)
End If
Range("B" & rowB) = xFname
Range("C" & rowC) = xDirect
rowB = rowB + 1
rowC = rowC + 1
xFname = VBA.Dir
Loop
End If
End With
End Sub
É estudando que se consegue. Quando quiser agradecer, clique no joinha. Marque como resolvido na parte que resolveu sua dúvida.

For this post the author klarc28 thanked:
valzito (Seg Jan 20, 2020 10:06 am)
klarc28
Membro
Membro
 
Mensagens: 1328
Registrado em: Sáb Dez 09, 2017 12:33 am
Has thanked: 33 times
Have thanks: 555 times

Re: importar arquivo de imagens e listar

Mensagempor valzito » Seg Jan 20, 2020 10:06 am

klark28,

Muito obrigado irmão! funcionou perfeitamente!
valzito
Membro
Membro
 
Mensagens: 46
Registrado em: Sáb Mar 23, 2019 2:58 am
Has thanked: 33 times
Have thanks: 3 times


Voltar para VBA & Macros

Quem está online

Usuários navegando neste fórum: Google Adsense [Bot], pwilm e 2 visitantes