[Resolvido]Tamannho arquivo de imagem vinculado

boa tarde a todos, estou o utilizo o seguinte VBA pego aqui no forum, me perdoem pois nao lembro quem disponibilizou..funcionando perfeitamente, agora quero aprimora-lo, quero algo que verifique o tamanho do arquivo, se for menor que 640K, ele deixe salvar o vinculo, senão, exibir a mensagem do tamanho do arquivo e pedir para que o usuário reduza


Dim strCaminho As String, strPastaInicial As String
strPastaInicial = "\\dara-01\Diversos\VISTORIACAÇAMBAS\"
strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
"Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
If Len(strCaminho) > 0 Then
Me.LocalFoto = strCaminho
Me.Foto.Picture = Me.LocalFoto



tentei juntar com esse outro Vba, que o grando Jpaulo publicou mas estou empacando em algo


'Requer ativa a referencia VBA
'Microsoft Scripting Runtime
Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject
Dim File As Scripting.File
Dim strCaminho As String
Dim fileSize As String

strCaminho = "D:\teste.jpg"

If FSO.FileExists(strCaminho) Then
Set File = FSO.GetFile(strCaminho)

fileSize = Format(File.Size / 1000000, "#,##0.00") & " " & "Megas"
MsgBox fileSize
End If

Bom dia,

É um pouco complicado sem a sua BD, mas tente com código abaixo... não testado.


Dim strCaminho As String, strPastaInicial As String
Dim FSO As Object
Dim File As Object
Dim fileSize As String
strPastaInicial = "C:\"
strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
"Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
If Len(strCaminho) > 0 Then
Me.LocalFoto = strCaminho
Me.Foto.Picture = Me.LocalFoto
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(strCaminho) Then
Set File = FSO.GetFile(strCaminho)
fileSize = Format(File.Size / 1000000, "#,##0.00") & " " & "Megas"
If File.Size < 640000 Then ' Aqui introduz o tamanho maximo que limite seu criterio 640K
MsgBox fileSize
DoCmd.Close , , acSavePrompt
Else
MsgBox "Imagem demasiado grande" & " " & fileSize & vbCrLf & "Tamanho maximo 640K", vbInformation, "Informação"
End If
End If

Caro Roberto_1977, deu certo adaptei, ficou show, agora o trampo maior vai ser ensinar os funcionários a redimensionar o tamanho das fotos, muito obrigado pela ajuda....


Show..

Bom dia,

Fico contente que tenha funcionado...

Sempre ao dispor..