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
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
Grande abraço e sucesso a todos!