Problema de tomar foto

Con el siguiente código estoy permitiendo tomar fotos con cualquier webcam, los otros códigos son para adelantar y atrás las fotos tomadas, tengo la siguiente duda estoy guardando como podría hacer para comprimir los posible estas fotos tomada, y ademas si es ideal como las estoy guardando como campo de texto y no como un campo ole, en la base de datos, también no he podido configurar el botón que se encuentra en la cámara para obtener la foto sin tocar el botón de tomar foto de la pantalla de control, gracias david
Estoy utilizando el control data.
Dim StrNombre As String
Dim NombreImageneS(1 To 1000) As String
Dim i As Integer
Dim imaN As Integer
Dim Min As Integer
Dim Max As Integer
Dim esFot As Boolean
Function GeneraName()
On Error Resume Next
Dim i As Integer
Dim j As Integer
Nom = Text20.Text
i = 1
For j = 1 To Len(Nom)
While ((Mid(Nom, i, 1) <> ";" And (Mid(Nom, i, 1) <> "")))
tMp = tMp + Mid(Nom, i, 1)
i = i + 1
Wend
NombreImageneS(j) = tMp
i = i + 1
tMp = ""
Next j
If (esFot = True) Then
For i = 1 To 100
If (NombreImageneS(i) <> "") Then
Min = i
i = 101
End If
Next i
For i = 100 To 0 Step -1
If (NombreImageneS(i) <> "") Then
Max = i
i = 0
End If
Next i
imaN = Min
esFot = False
End If
End Function
Private Sub CmdAdela_Click()
On Error Resume Next
Dim tmpnamE
GeneraName
imaN = imaN + 1
If (imaN = Max) Then
MsgBox "No hay mas fotos"
imaN = imaN - 1
Exit Sub
End If
tmpnamE = NombreImageneS(imaN)
OLE1.Class = "Paint.Picture"
OLE1.CreateLink App.Path & "\" & tmpnamE
OLE1.Refresh
End Sub
Private Sub CmdAtras_Click()
On Error Resume Next
GeneraName
imaN = imaN - 1
If imaN < Min Then
MsgBox "No hay mas fotos"
imaN = imaN + 1
Exit Sub
End If
tmpnamE = NombreImageneS(imaN)
OLE1.Class = "Paint.Picture"
OLE1.CreateLink App.Path & "\" & tmpnamE
OLE1.Refresh
OLE1.Refresh
End Sub
Private Sub Data1_Validate(Action As Integer, Save As Integer)
Text1.Text = Format(Text1.Text, "0000#")
esFot = True
End Sub
Private Sub CmdFoto_Click()
On Error Resume Next
StrNombre = GeneraNombre
esFot = True
i1.FileType = BMP_Bitmap
i1.Image = App.Path & "\" & StrNombre
i1.ScanTo = DisplayAndFile
i1.OpenScanner
i1.StartScan
i1.StopScan
i1.CloseScanner
OLE1.Class = "Paint.Picture"
OLE1.CreateLink App.Path & "\" & StrNombre
OLE1.Refresh
GeneraName
Text20.Text = Text20.Text & ";" & StrNombre
End Sub
Function GeneraNombre() As String
Dim Str As String
Str = Format(Now, "ddmmyyhhmmss")
Str = Str & ".bmp"
GeneraNombre = Str
End Function