Ir ao conteúdo
  • Comunicados

    • Gabriel Torres

      Seja um moderador do Clube do Hardware!   12-02-2016

      Prezados membros do Clube do Hardware, Está aberto o processo de seleção de novos moderadores para diversos setores ou áreas do Clube do Hardware. Os requisitos são:   Pelo menos 500 posts e um ano de cadastro; Boa frequência de participação; Ser respeitoso, cordial e educado com os demais membros; Ter bom nível de português; Ter razoável conhecimento da área em que pretende atuar; Saber trabalhar em equipe (com os moderadores, coordenadores e administradores).   Os interessados deverão enviar uma mensagem privada para o usuário @Equipe Clube do Hardware com o título "Candidato a moderador". A mensagem deverá conter respostas às perguntas abaixo:   Qual o seu nome completo? Qual sua data de nascimento? Qual sua formação/profissão? Já atuou como moderador em algo outro fórum, se sim, qual? De forma sucinta, explique o porquê de querer ser moderador do fórum e conte-nos um pouco sobre você.   OBS: Não se trata de função remunerada. Todos que fazem parte do staff são voluntários.
    • DiF

      Poste seus códigos corretamente!   21-05-2016

      Prezados membros do Fórum do Clube do Hardware, O Fórum oferece um recurso chamado CODE, onde o ícone no painel do editor é  <>     O uso deste recurso é  imprescindível para uma melhor leitura, manter a organização, diferenciar de texto comum e principalmente evitar que os compiladores e IDEs acusem erro ao colar um código copiado daqui. Portanto convido-lhes para ler as instruções de como usar este recurso CODE neste tópico:  
Marcus Nagel_758472

Macro vba exportar arquivo excel - resolvido

Recommended Posts

[RESOLVIDO!!!!]

 

Boa noite pessoal.

 

Preciso de uma ajudinha para ajustar uma macro. Hoje ela separa as informações por fornecedor e cria um arquivo dentro de uma pasta no C: para cada fornecedor.

Tenho uma planilha com algumas informações entre elas Fornecedor Agrupado.

Em outra aba tenho essa mesma coluna Fornecedor Agrupado e a coluna Site Sharepoint, onde contem o caminho que quero exportar o arquivo de cada fornecedor. Cada fornecedor possui um caminho diferente.

 

Tenho os dois códigos a seguir:

Sub a02EnviarEmails()

Dim Folder As String, Recipient As String, Recipient2 As String
Dim FSO As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset, rs2 As DAO.Recordset
Dim c As Long


Application.DisplayAlerts = False

Folder = "C:\Users\marcur09\Desktop\A\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set db = OpenDatabase(ThisWorkbook.FullName, False, True, "Excel 8.0;HDR=Yes;")
Set rs = db.OpenRecordset("SELECT DISTINCT [Fornecedor Agrupado] FROM [Plan1$]")


For Each File In FSO.GetFolder(Folder).Files
    Kill File
Next

While Not rs.EOF
    Set rs2 = db.OpenRecordset("SELECT * FROM [Plan1$] WHERE [Fornecedor Agrupado]='" & rs(0) & "'")
    Workbooks.Add
        For c = 0 To rs2.Fields.Count - 1
            Cells(1, c + 1) = rs2.Fields(c).Name
        Next
    Range("A2").CopyFromRecordset rs2
    Range("A:A").TextToColumns
    Range("A:A").NumberFormat = "dd/mm/yyyy"
    Range("P:P").NumberFormat = "dd/mm/yyyy"
    Range("A:AZ").EntireColumn.AutoFit
    ActiveWorkbook.Close True, Folder & Format(Date, "dd-mm-yyyy") & " " & rs(0)
        rs.MoveNext
Wend

End Sub
Sub tst()

Const sSource As String = "C:\Users\marcur09\Desktop\A\3M.xlsx" 'change to suit

With CreateObject("WScript.Network")

.MapNetworkDrive "T:", "\\team.braskem.com.br\sites\gpss\mro\Produtividade\_Marcus\teste\3M" 'change to suit
If Len(Dir(sSource)) Then CreateObject("Scripting.FileSystemObject").copyfile sSource, "T:\"
Application.Wait Now + TimeSerial(0, 0, 3)

On Error Resume Next
.RemoveNetworkDrive "T:"
On Error GoTo 0

End With

End Sub

 

Conseguem me ajudar???

 

OBRIGADO!!!

Teste 1 Macro Export To SharePoint .xlsm

Editado por Marcus Nagel_758472
Duvida resolvida

Compartilhar este post


Link para o post
Compartilhar em outros sites

Daria pra ajudar se você soubessemos o que você precisa, afinal você disse que tem o codigo e que precisa de ajuda, mas nao disse qual.

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites
  • Autor do tópico
  • @CasaDoHardware Desculpe, escrevi meio apressado.

     

    A primeira macro (a02EnviarEmails) divide o arquivo por fornecedor, cria um arquivo diferente para cada um desses fornecedores e coloca a data que foi executada. Ex: 23-02-2016 3M.xlsx

    Preciso de uma macro que pegue esses arquivos que estão numa pasta no drive C e export para o sharepoint indicado na aba "banco_dados", coluna "Site Sharepoint". 

     

    Por exemplo:

     

    o arquivo 3M tem que ser exportado para a pasta "https://sharepoint/mysite/3M".

    o arquvio Abecom para "https://sharepoint/mysite/Abecom".

    e por ai vai.....

     

    A segunda macro (tst) exporta o arquivo para o local certo, porém preciso copiar e colar varias vezes, pois ela serve apenas para um fornecedor. E devido a data que a macro "a02EnviarEmails" coloca no nome do arquivo, teria que entrar e mudar todas as vezes que for utilizar.

     

    Acho que agora deu para explicar.

     

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Nao entendi o que você altera no codigo manualmente para funcionar...

     

    Mas da seja la o que for e so fazer um for para que essa alteração aconteça pelo codigo uma sugestão seria criar uma lista que pode ser apagada cada vez que o codigo rodar, para usar no for de inserção.

     

    Posso tentar fazer o For mas nao entendi onde deve ser alterado para funcionar como você precisa.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • @CasaDoHardware

     

    Sub tst()
    
    Const sSource As String = "C:\Users\marcur09\Desktop\A\3M.xlsx" 'change to suit
    
    With CreateObject("WScript.Network")

    Essa parte "Const sSource ........... \Desktop\A\3M.xlsx."

    A parte em negrito eu teria que mudar manualmente, pois ela é o arquivo que desejo exportar. O problema é que quando rodo a primeira macro, ela salva o arquivo como (exemplo) 24-02-2016 3M.xlsx e o nome deve ser exatamente o mesmo para a segunda macro funcionar.

     

    Precisava de algo que faça com que na primeira macro ele salve o arquivo e já exporte para o sharepoint, sem ser necessário a segunda macro.

     

    Macro:

     

    Separar Fornecedor -> Salvar um arquivo para cada fornecedor -> exportar cada fornecedor para sua pasta no sharepoint ( de acordo com a coluna "Site Sharepoint" da aba "banco_dados" do arquivo inicial)

     

     

    Se ficar mais fácil, a primeira macro pode ser alterada.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Uma coisa que vi no seu arquivo é que você tem uma lista com os caminhos e uma macro para cada planilha gerada???

     

    E só estes tres???

     

     

    Se for só o problema de enviar todos os arquivo em um unico comando

     

     

    pode usar esse

     

     

    Sub Enviartudo()

     

    'Se quiser enviar alguma macro antes dessas 3 é so inserir antes aqui 


    Call tst
    Call tst2
    Call tst3

     

    End Sub

     

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • @CasaDoHardware

     

    Se o nome dos arquivos não fosse dinamico poderia usar essa sim.

     

    Acontece que o nome do arquivo muda conforme o dia que for executado.

    @CasaDoHardware

    Sub a02EnviarEmails()
    
    Dim Folder As String, Recipient As String, Recipient2 As String
    Dim FSO As Object
    Dim db As DAO.Database
    Dim rs As DAO.Recordset, rs2 As DAO.Recordset
    Dim c As Long
    
    
    Application.DisplayAlerts = False
    
    Folder = "C:\Users\marcur09\Desktop\A\"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set db = OpenDatabase(ThisWorkbook.FullName, False, True, "Excel 8.0;HDR=Yes;")
    Set rs = db.OpenRecordset("SELECT DISTINCT [Fornecedor Agrupado] FROM [Plan1$]")
    
    
    For Each File In FSO.GetFolder(Folder).Files
        Kill File
    Next
    
    While Not rs.EOF
        Set rs2 = db.OpenRecordset("SELECT * FROM [Plan1$] WHERE [Fornecedor Agrupado]='" & rs(0) & "'")
        Workbooks.Add
            For c = 0 To rs2.Fields.Count - 1
                Cells(1, c + 1) = rs2.Fields(c).Name
            Next
        Range("A2").CopyFromRecordset rs2
        Range("A:A").TextToColumns
        Range("A:A").NumberFormat = "dd/mm/yyyy"
        Range("P:P").NumberFormat = "dd/mm/yyyy"
        Range("A:AZ").EntireColumn.AutoFit
        ActiveWorkbook.Close True, Folder & Format(Date, "dd-mm-yyyy") & " " & rs(0)
    ''''''''''''''''' Pegar esse arquivo salvo acima e exportar para o sharepoint''''''''''''''''''
    
    
            rs.MoveNext
    Wend
    
    End Sub

    No código acima coloquei uma linha "Pegar esse arquivo salvo acima e exportar para o sharepoint", para dar uma ideia do que preciso.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Declara uma variavel para o nome do arquivo

     

    Dim arquivo as string

     

    Arquivo = nome que quiser

     

    No lugar do nome do arquivo use assim

     

    No lugar disso

     

    C:\Users\marcur09\Desktop\A\3M.xlsx

     

    Use isso.

    C:\Users\marcur09\Desktop\A\ & Arquivo & ".xlsx"

     

     

    Editado por CasaDoHardware
    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • @CasaDoHardware

    Tem como 

    esse C:\Users\marcur09\Desktop\A\ & Arq & ".xlsx" mostrar a data atual e o nome do fornecedor? Se fizer isso já vai ser top!!!!

     

    Exemplo: Fornecedor Abecom

    C:\Users\marcur09\Desktop\A\Format(Date, "dd-mm-yyyy") & " " & Arq & ".xlsx"

    Ai aparece:

    C:\Users\marcur09\Desktop\A\24-02-2016 Abecom.xlsx

     

    E outra pergunta. Como faço para exportar para o site mostrado na aba [base_dados]?

    Editado por Marcus Nagel_758472

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Suponha que o nome do arquivo seja a celula A1

     

    então fica assim

     

    Dim Arquivo as string

     

    Arquivo = Format(Date, "DD.MM.YYYY") & " - " & Range("A1").Value

    E so usar a do modo que disse anteriormente

     

    C:\Users\marcur09\Desktop\A\ & Arquivo & ".xlsx"

     

    O arquivo vai ser salvo com a data e o nome que estiver em A1 (troque de acordo com sua necessidade.)

    Editado por CasaDoHardware
    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • @CasaDoHardware

     

    Com sua ajuda consegui fazer o que queria!

    Usei apenas a primeira macro com algumas ideias de modificação que você deu! 

    MUITO OBRIGADO!!!

     

    Segue o código para alguem se precisar.

    Divide a planilha com base no Fornecedor e salva na pasta de cada Fornecedor no sharepoint.

     

    Sub aExportParaSharepoint()
    
    Dim Folder As String
    Dim Caminho As String
    Dim Fornecedor As String
    Dim FSO As Object
    Dim db As DAO.Database
    Dim rs As DAO.Recordset, rs2 As DAO.Recordset
    Dim c As Long
    
    
    Application.DisplayAlerts = False
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set db = OpenDatabase(ThisWorkbook.FullName, False, True, "Excel 8.0;HDR=Yes;")
    Set rs = db.OpenRecordset("SELECT DISTINCT [Fornecedor Agrupado] FROM [Plan1$]")
    While Not rs.EOF
        Set rs2 = db.OpenRecordset("SELECT * FROM [Plan1$] WHERE [Fornecedor Agrupado]='" & rs(0) & "'")
        Workbooks.Add
            For c = 0 To rs2.Fields.Count - 1
                Cells(1, c + 1) = rs2.Fields(c).Name
            Next
    
    Caminho = "\\mysite\sites\gpss\mro\teste\" 'troque pelo caminho da pasta do sharepoint
    Fornecedor = rs(0) & "\" 'pega o fornecedor e complementa o Caminho
    
    Let Folder = Caminho & Fornecedor 'Caminho completo
    
    Range("A2").CopyFromRecordset rs2
        Range("A:A").TextToColumns
        Range("A:A").NumberFormat = "dd/mm/yyyy"
        Range("P:P").NumberFormat = "dd/mm/yyyy"
        Range("A:AZ").EntireColumn.AutoFit
        Range("A1:C1").Interior.Color = RGB(228, 31, 43)
        Range("a1:c1").Font.ColorIndex = 2
        Range("A1:C1").Font.Bold = True
        ActiveWorkbook.Close True, Folder & Format(Date, "dd-mm-yyyy") & " " & rs(0) 'salva na pasta com data e o nome do fornecedor
    
            rs.MoveNext
    Wend
    
    For Each File In FSO.GetFolder(Folder).Files
        Kill File
    Next
    
    End Sub

     

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Crie uma conta ou entre para comentar

    Você precisar ser um membro para fazer um comentário






    Sobre o Clube do Hardware

    No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

    Direitos autorais

    Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

    ×