Caros, peço ajuda aos de boa vontade a fim de com base na avaliação do código abaixo possa identificar o motivo de não estar sendo gravado na pasta indicada o arquivo gerado por foto capturada da webcam. As demais funções, inclusive a gravação no form inicial do cadastro do caminho da foto está ok, mas o arquivo não é salvo na pasta.
Como agravante, comento que a máquina que estou com problema foi recentemente formatada, tendo o backup sido restaurado, as referencias indicadas no access e também a dll SSGetContents sido gravada tanto no System32 Quanto no SysWo64 (meu sistema é W7 64Bits). Ocorre que o mesmo módulo "continua funcionando normalmente" em outra máquina com a mesma configuração, o que indica algo com o sistema/arquivos da máquina recuperada.
O módulo foi desenvolvido por profissional ao qual não tive acesso após várias tentativas, e se baseia no módulo camaraweb disponibilizado neste site. Assim, não sendo usuário avançado desta grande ferramenta que é o access, peço a gentil ajuda dos que possam colaborar.
---------------
Private Sub CmdCapturaImagem_Click()
On Error GoTo Err_CmdCapturaImagen_Click
capEditCopy lwndC
On Error Resume Next
Dim strCaminnhoPasta As String
strCaminnhoPasta = DLookup("[LocalFoto]", "tblConfig")
Me.OLEPic.SetFocus
DoCmd.RunCommand acCmdPaste
DoCmd.RunCommand acCmdSaveRecord
Dim a() As Byte
Dim b() As Byte
Dim x As Long
Dim lTemp As Long
Dim sl As String
Dim blRet As Boolean
Dim sExt As String
Dim sFileExist As String
' This is an optional param we pass to fGetContentsStream.
' It will contain the original file name of the
' object when embedded as a Package.
Dim PackageFileName As String
Dim iFileHandle As Integer
' Load our Structured Storage Library
' Let's see if the StrStorage.DLL is available.
blRet = LoadLib()
If blRet = False Then
' Cannot find StrStorage.dll file
Exit Sub
End If
lTemp = LenB(Me.OLEPic.Value)
ReDim a(0 To lTemp - 1)
ReDim b(0 To lTemp - 1)
' Copy the contents of the OLE field to our byte array
a = Me.OLEPic.Value
' Make a copy of the original data
b = a
blRet = fGetContentsStream(a(), sExt, PackageFileName)
If blRet = True Then
If sExt = "pak" Then
' If a file was dragged from the Explorer window
' it will have a Package object Filename of NULL
' inserted by Shell.DLL
' Catch and give a temp file name
If Len(PackageFileName & vbNullString) < 3 Then
PackageFileName = "OLE-ExtractDraggedFromExplorer" & "." & "bmp"
End If
iFileHandle = FreeFile
sl = "C:\" & PackageFileName
sFileExist = Dir(sl)
If Len(sFileExist & vbNullString) > 0 Then
Kill sl
End If
Open sl For Binary Access Write As iFileHandle
Put iFileHandle, , a
Close iFileHandle
Else
iFileHandle = FreeFile
sl = "C:\" & sExt & UBound(a) & "." & sExt
sFileExist = Dir(sl)
If Len(sFileExist & vbNullString) > 0 Then
Kill sl
End If
Open sl For Binary Access Write As iFileHandle
Put iFileHandle, , a
'Put iFileHandle, , Me.FotoMembro
Close iFileHandle
End If
Dim StartRegisteredApp As Boolean
'StartRegisteredApp = True
' Do we open the exported OLE object in the
' Application registered for this file type on this system?
If StartRegisteredApp = True Then
' Some apps require vbNullString for the first parameter,
' other apps require "open" for the first parameter
ShellExecuteA Application.hWndAccessApp, vbNullString, sl, vbNullString, vbNullString, 1
End If ' "open"
End If
Dim strCaminho As String, strPastaInicial As String
Dim CopiaSegura As Object
' Faz a cópia do arquivo para a pasta do bd e sub pasta Fotos renomeando para jpg
Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
' CopiaSegura.CopyFile sl, strCaminnhoPasta & Me.cxNumeroCadastral.Value & " - " & Me.Nome_Cliente.Value & ".jpg"
CopiaSegura.CopyFile sl, strCaminnhoPasta & Me.cxNumeroCadastral.Value & ".jpg"
' Forms.frmFoto.Foto_Cliente = strCaminnhoPasta & Me.cxNumeroCadastral.Value & " - " & Me.Nome_Cliente.Value & ".jpg"
' Forms.frmFoto.img.Picture = Forms.frmFoto.Foto_Cliente
Forms.FrmCadCliente.LocalFoto = strCaminnhoPasta & Me.cxNumeroCadastral.Value & ".jpg"
Forms.FrmCadCliente.Foto.Picture = Forms.FrmCadCliente.LocalFoto
DoCmd.Close acForm, "Camara_Web"
Exit_CmdCapturaImagen_Click:
Exit Sub
Err_CmdCapturaImagen_Click:
MsgBox Err.Description
Resume Exit_CmdCapturaImagen_Click
End Sub
Como agravante, comento que a máquina que estou com problema foi recentemente formatada, tendo o backup sido restaurado, as referencias indicadas no access e também a dll SSGetContents sido gravada tanto no System32 Quanto no SysWo64 (meu sistema é W7 64Bits). Ocorre que o mesmo módulo "continua funcionando normalmente" em outra máquina com a mesma configuração, o que indica algo com o sistema/arquivos da máquina recuperada.
O módulo foi desenvolvido por profissional ao qual não tive acesso após várias tentativas, e se baseia no módulo camaraweb disponibilizado neste site. Assim, não sendo usuário avançado desta grande ferramenta que é o access, peço a gentil ajuda dos que possam colaborar.
---------------
Private Sub CmdCapturaImagem_Click()
On Error GoTo Err_CmdCapturaImagen_Click
capEditCopy lwndC
On Error Resume Next
Dim strCaminnhoPasta As String
strCaminnhoPasta = DLookup("[LocalFoto]", "tblConfig")
Me.OLEPic.SetFocus
DoCmd.RunCommand acCmdPaste
DoCmd.RunCommand acCmdSaveRecord
Dim a() As Byte
Dim b() As Byte
Dim x As Long
Dim lTemp As Long
Dim sl As String
Dim blRet As Boolean
Dim sExt As String
Dim sFileExist As String
' This is an optional param we pass to fGetContentsStream.
' It will contain the original file name of the
' object when embedded as a Package.
Dim PackageFileName As String
Dim iFileHandle As Integer
' Load our Structured Storage Library
' Let's see if the StrStorage.DLL is available.
blRet = LoadLib()
If blRet = False Then
' Cannot find StrStorage.dll file
Exit Sub
End If
lTemp = LenB(Me.OLEPic.Value)
ReDim a(0 To lTemp - 1)
ReDim b(0 To lTemp - 1)
' Copy the contents of the OLE field to our byte array
a = Me.OLEPic.Value
' Make a copy of the original data
b = a
blRet = fGetContentsStream(a(), sExt, PackageFileName)
If blRet = True Then
If sExt = "pak" Then
' If a file was dragged from the Explorer window
' it will have a Package object Filename of NULL
' inserted by Shell.DLL
' Catch and give a temp file name
If Len(PackageFileName & vbNullString) < 3 Then
PackageFileName = "OLE-ExtractDraggedFromExplorer" & "." & "bmp"
End If
iFileHandle = FreeFile
sl = "C:\" & PackageFileName
sFileExist = Dir(sl)
If Len(sFileExist & vbNullString) > 0 Then
Kill sl
End If
Open sl For Binary Access Write As iFileHandle
Put iFileHandle, , a
Close iFileHandle
Else
iFileHandle = FreeFile
sl = "C:\" & sExt & UBound(a) & "." & sExt
sFileExist = Dir(sl)
If Len(sFileExist & vbNullString) > 0 Then
Kill sl
End If
Open sl For Binary Access Write As iFileHandle
Put iFileHandle, , a
'Put iFileHandle, , Me.FotoMembro
Close iFileHandle
End If
Dim StartRegisteredApp As Boolean
'StartRegisteredApp = True
' Do we open the exported OLE object in the
' Application registered for this file type on this system?
If StartRegisteredApp = True Then
' Some apps require vbNullString for the first parameter,
' other apps require "open" for the first parameter
ShellExecuteA Application.hWndAccessApp, vbNullString, sl, vbNullString, vbNullString, 1
End If ' "open"
End If
Dim strCaminho As String, strPastaInicial As String
Dim CopiaSegura As Object
' Faz a cópia do arquivo para a pasta do bd e sub pasta Fotos renomeando para jpg
Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
' CopiaSegura.CopyFile sl, strCaminnhoPasta & Me.cxNumeroCadastral.Value & " - " & Me.Nome_Cliente.Value & ".jpg"
CopiaSegura.CopyFile sl, strCaminnhoPasta & Me.cxNumeroCadastral.Value & ".jpg"
' Forms.frmFoto.Foto_Cliente = strCaminnhoPasta & Me.cxNumeroCadastral.Value & " - " & Me.Nome_Cliente.Value & ".jpg"
' Forms.frmFoto.img.Picture = Forms.frmFoto.Foto_Cliente
Forms.FrmCadCliente.LocalFoto = strCaminnhoPasta & Me.cxNumeroCadastral.Value & ".jpg"
Forms.FrmCadCliente.Foto.Picture = Forms.FrmCadCliente.LocalFoto
DoCmd.Close acForm, "Camara_Web"
Exit_CmdCapturaImagen_Click:
Exit Sub
Err_CmdCapturaImagen_Click:
MsgBox Err.Description
Resume Exit_CmdCapturaImagen_Click
End Sub