Copíar Arquivo para Área de Trabalho

2024 - VBA & Macros

Post Recente por romanholi 7 anos atrás

4 Posts

3 Usuários

0 Reactions

1,004 Visualizações

RSS

romanholi

(@romanholi)

Posts: 177

Estimable Member

Topic starter

Pessoal, bom dia.

Como eu faço uma macro para copiar um arquivo de uma determinada pasta que está na rede para área de trabalho. Mas para qualquer área de trabalho, visto que várias pessoas irão executar esta macro.

O caminho da área de trabalho contém o nome do usuário. :-(

C:UsersfromanholiDesktopBackup

A macro teria que funcionar da seguinte forma:

Copiar o arquivo:
C:UsersfromanholiDesktopMeus_ArquivosDesenvolvendoSistema AnomaliasBase_Dados.xlsx

Criar uma pasta na área de trabalho:
Análise dos Dados

E copiar o arquivo Base_Dados.xlsx nesta pasta.

Lembrando que o usuário vai executar isso diariamente e que pode copiar o arquivo por cima.

Obrigado Pessoal

Postado : 05/06/2018 5:03 am

EdsonBR

(@edsonbr)

Posts: 1057

Noble Member

Bom dia, Romanholi

Teste a rotina abaixo:

Sub CopiarParaDesktop()
  Const arquivo = "Base_Dados.xlsx"
  Dim pastaOrigem As String, pastaDestino As String, desktop As String
  desktop = CreateObject("Shell.Application").Namespace(16).Self.Path & ""
  pastaOrigem = desktop & "Meus_ArquivosDesenvolvendoSistema Anomalias"
  pastaDestino = desktop & "Análise dos Dados"
  With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(pastaDestino) Then .CreateFolder (pastaDestino)
    .CopyFile Source:=pastaOrigem & arquivo, Destination:=pastaDestino & arquivo, _
              OverWriteFiles:=True
  End With
End Sub

Obs.: não incluído tratamento de erros, caso a pasta de origem e/ou o arquivo não exista nessa pasta.

Postado : 05/06/2018 7:02 am

Wagner Morel

(@wagner-morel-vidal-nobre)

Posts: 0

Illustrious Member

Excelente Edson!

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

Postado : 05/06/2018 7:44 am