Tomás Vásquez Fórum

Enviado: **Qui Dez 28, 2017 8:51 am**

Bom dia meus amigos!
Estou precisando de sua ajuda com uma tarefa!
Tenho um formulário em Excel que armazena algumas informações em uma aba que utilizo como banco de dados, e junto com essas informações preciso anexar o caminho de um arquivo em pdf que é uma evidência documental que o usuário poderá abrir quando necessário.
Para garantir que os anexos (arquivos em pdf) não se percam e estejam organizados em um só lugar criei uma pasta chamada bd_anexos.
Preciso de um código que ao selecionar o arquivo em pdf no PC, automaticamente seja salvo uma cópia deste arquivo na pasta bd_anexos, para que o usuário não precise:

1- abrir a pasta do arquivo a ser anexado,
2- copiar o arquivo a ser anexado,
3- abrir a pasta bd_anexos,
4- colar o arquivo a ser anexado,
5- para então anexar o pdf no formulário.

Segue abaixo o código que utilizo para anexar o caminho do arquivo.

Código: Selecionar todos

Private Sub btn_AnexarPDF_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim local_pdf As String
Dim caminho As String

On Error Resume Next

Application.DisplayAlerts = False

local_pdf = Application.GetOpenFilename(filefilter:="PDF Files,*.pdf")
Me.txt_Localpdf.Text = local_pdf

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Para auxiliar no entendimento utilizo um código que faz exatamente o que preciso com imagens, o código salva uma cópia da imagem a partir do objeto imagem dentro do formulário, porém não consigo adaptar esta função para o arquivo em pdf.
Segue abaixo o código a que me refiro.

Código: Selecionar todos

Private Sub bto_Imagem_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim strCaminho As String
Dim strNomeImagem As String
Dim separa_pasta As String
Dim parte() As String
Dim descricao As String
Dim local_imagem As String
Dim caminho As String
Dim pasta As Object, NomePasta

On Error Resume Next

Application.DisplayAlerts = False

If Me.txt_NumReg = "" Then
MsgBox ("Informe primeiro um registro para inserir uma foto!")
Exit Sub
End If

local_imagem = Application.GetOpenFilename(filefilter:="Picture Files,*.bmp;*.jpg")
Me.Image1.Picture = LoadPicture("")
Me.Image1.Picture = LoadPicture(local_imagem)
Me.Image1.PictureSizeMode = fmPictureSizeModeStretch

       Set pasta = CreateObject("Scripting.FileSystemObject")
    NomePasta = ActiveWorkbook.Path & "\" & "BD_Imagens"
    
        If Not pasta.FolderExists(NomePasta) Then
        pasta.CreateFolder (NomePasta)
    End If
    
strReg = Me.txt_NumReg.Text

nome_arquivo = "Registro_" & strReg & ".bmp"

Base = NomePasta & "\"

local_arquivo = Base & nome_arquivo

SavePicture Me.Image1.Picture, local_arquivo

Me.txt_LocalImagem = local_arquivo

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Desde já agradeço pela ajuda.

Grande abraço e sucesso a todos!

Enviado: **Qui Dez 28, 2017 12:18 pm**

Segue uma possibilidade

Código: Selecionar todos

Private Sub btn_AnexarPDF_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim local_pdf As String, Nome_Pdf As String
Dim caminho As String, NomePasta As String
Dim pasta As Object
Dim StrNome() As String

On Error Resume Next

Application.DisplayAlerts = False
'Verifica se pasta existe, caso não cria pasta bd_anexos
Set pasta = CreateObject("Scripting.FileSystemObject")
NomePasta = ActiveWorkbook.Path & "\" & "bd_anexos"
    If Not pasta.FolderExists(NomePasta) Then pasta.CreateFolder (NomePasta)
'Captura caminho e nome do arquivo pdf
local_pdf = Application.GetOpenFilename(filefilter:="PDF Files,*.pdf")
StrNome = Split(local_pdf, "\")
'Identifica nome do arquivo PDF
Nome_Pdf = StrNome(UBound(StrNome))
'Copia arquivo Pdf para pasta bd_anexos
FileCopy local_pdf, NomePasta & "\" & Nome_Pdf
'Informa na txt nome e local do pdf
Me.txt_Localpdf.Text = NomePasta & "\" & Nome_Pdf

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Tomás Vásquez Fórum

Ajuda Como Criar Cópia de Arquivo PDF Automaticamente Excel VBA

Ajuda Como Criar Cópia de Arquivo PDF Automaticamente Excel VBA

Re: Ajuda Como Criar Cópia de Arquivo PDF Automaticamente Excel VBA