MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Erro em módulo gravação de foto da webcam

    Compartilhe

    eduas65
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 10
    Registrado : 30/10/2012

    Erro em módulo gravação de foto da webcam

    Mensagem  eduas65 em Qui 05 Maio 2016, 21:01

    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

      Data/hora atual: Sab 10 Dez 2016, 06:48