Notifications
Clear all

Alterar macro original por macro alterada

11 Posts
3 Usuários
0 Reactions
1,953 Visualizações
(@jnexcel)
Posts: 0
New Member
Topic starter
 

Bom dia

Por favor, alguém poderia me ajudar?

Preciso alterar uma macro original por uma alterada, porém eu não estou conseguindo fazer a macro alterada funcionar na planilha nova.

macro original:

    ActiveWorkbook.XmlMaps("XML").Import URL:= _
        "C:UsersFiscalDesktopARQUIVOS XMLXML.xml"

macro alterada:

Public Sub ListaArquivos()
'Atenção: Faça referência à biblioteca Micrsoft Scripting Runtime
Dim FSO As New FileSystemObject
Dim result() As String
Dim Pasta As Folder
Dim Arquivo As File
Dim Indice As Long
Dim caminho As String
caminho = "C:TempARQUIVOS XML" 'Aqui altere para o seu diretorio

ReDim result(0) As String
If FSO.FolderExists(caminho) Then
Set Pasta = FSO.GetFolder(caminho)

For Each Arquivo In Pasta.Files
' Indice = IIf(result(0) = "", 0, Indice + 1)
' ReDim Preserve result(Indice) As String
' result(Indice) = Arquivo.Name

ActiveWorkbook.XmlMaps("nfeProc_Mapa").Import URL:=Arquivo
Next
End If

' ListaArquivos = result
ErrHandler:
Set FSO = Nothing
Set Pasta = Nothing
Set Arquivo = Nothing

End Sub

Private Sub CommandButton1_Click()
ListaArquivos
End Sub

Preciso inserir esse código na planilha anexa, mas eu não estou conseguindo fazer isso.

muito obrigado a todos pela atenção.

 
Postado : 20/02/2018 4:50 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não vi o arquivo, mas deve ser pela Variável, voce definiu a mesma com o nome de "caminho" e está usando "Arquivo"

caminho = "C:TempARQUIVOS XML" 'Aqui altere para o seu diretorio

ActiveWorkbook.XmlMaps("nfeProc_Mapa").Import URL:=Arquivo

Altere a Variável na linha

ActiveWorkbook.XmlMaps("nfeProc_Mapa").Import URL:=caminho 

[]s

 
Postado : 20/02/2018 5:06 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

uma possibilidade:

Private Sub CommandButton1_Click()
ListaArquivos
End Sub

Public Sub ListaArquivos()
'Atenção: Faça referência à biblioteca Micrsoft Scripting Runtime
Dim FSO As New FileSystemObject
Dim result() As String
Dim Pasta As Folder
Dim Arquivo As File
Dim Indice As Long
Dim Caminho As String
Caminho = "C:TempARQUIVOS XML" 'Aqui altere para o seu diretorio
ReDim result(0) As String
If FSO.FolderExists(Caminho) Then
    Set Pasta = FSO.GetFolder(Caminho)
    For Each Arquivo In Pasta.Files
        ActiveWorkbook.XmlMaps(1).Import URL:=Arquivo
    Next
End If

ErrHandler:
Set FSO = Nothing
Set Pasta = Nothing
Set Arquivo = Nothing

End Sub
 
Postado : 20/02/2018 8:43 am
(@jnexcel)
Posts: 0
New Member
Topic starter
 

Olá, agradeço pela atenção de vocês.

Eu tentei as duas formas apresentadas, porém continua com erro.

Em anexo, segue a tela contendo o erro.

o que será que eu estou fazendo de errado? :?: :?:

 
Postado : 20/02/2018 8:51 am
(@klarc28)
Posts: 0
New Member
 

Siga os passos:

 
Postado : 20/02/2018 8:56 am
(@jnexcel)
Posts: 0
New Member
Topic starter
 

Olá, já fiz referência, obrigado por mostrar esse erro.

Agora está com erro de acesso negado :?: :?: :?:

Em anexo, segue a imagem.

 
Postado : 20/02/2018 9:10 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

ActiveWorkbook.XmlMaps(1).Import URL:=Arquivo

 
Postado : 20/02/2018 9:23 am
(@jnexcel)
Posts: 0
New Member
Topic starter
 

Agora está com erro de análise de xml.

e agora :lol: :lol: :lol:

acho que estou fazendo mais coisas erradas :shock: :shock:

 
Postado : 20/02/2018 9:29 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Verifique a String que define Caminho, se esta correta. Inicialmente esta como c:TempArquivos Xml
Verifique se no diretorio especificado tem extensões diferentes de xml (tipo zip, xlsm....)

 
Postado : 20/02/2018 9:47 am
(@jnexcel)
Posts: 0
New Member
Topic starter
 

Olá, o código está funcionando 99%, o unico problema agora é que ele não mantem as informações anteriores. Exemplo: se na pasta arquivos xml conter 200 arquivos xml, ao invés do código importar os 200 ele importa apenas o úlitmo. ele está sobrescrevendo as informações ao invés de inserir novos valores. Por favor, você poderia me ajudar a resolver esse problema?

 
Postado : 20/02/2018 12:31 pm
(@jnexcel)
Posts: 0
New Member
Topic starter
 

Olá, apenas para avisar que consegui resolver o problema.

muito obrigado a todos pela atenção.

em anexo, segue o procedimento realizado

 
Postado : 20/02/2018 2:44 pm