Add ADO RecordCount

[patriciaxxx]

I have the following code which I run form a button on a form which simply calls the InsertBLOB function. The forms record source is set to the table tblBlob.

Problem 1
I would like to include a count of the number of new records added which could simply be displayed in a msgbox which displays after the code has run

Problem 2
Once the code has run the form does not update to show the records added. I have tried putting Requery on all the forms events but it does not work. The only way I can make Requery work is by adding a button with it and running it on demand. But I need the form to Requery itself properyly.

Function InsertBLOB(varFileName As Variant) As Boolean
'Inserts BLOB to file from table tblBLOB
On Error GoTo CloseUp

Dim objStream As Object 'ADODB.Stream
Dim objCmd As Object 'ADODB.Command
Dim varFileBinary

Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary
objStream.Open
objStream.LoadFromFile varFileName
varFileBinary = objStream.Read
objStream.Close
Set objStream = Nothing


Dim conn As ADODB.Connection
Dim myRecordset As ADODB.Recordset
Dim strConn As String
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.path & "\" & CurrentProject.Name

Set myRecordset = New ADODB.Recordset
With myRecordset
.Open "Select * from tblBlob", _
strConn, adOpenKeyset, adLockOptimistic
.AddNew
!FileName = Left(Mid(varFileName, InStrRev(varFileName, "\") + 1), InStrRev(Mid(varFileName, InStrRev(varFileName, "\") + 1), ".") - 1)
!FileExt = Right(varFileName, Len(varFileName) - InStrRev(varFileName, "."))
!Blob = varFileBinary
.MoveFirst
.Close
End With

Set myRecordset = Nothing
Set conn = Nothing

InsertBLOB = True

CloseUp:
On Error Resume Next
Set objStream = Nothing
Set objCmd = Nothing

End Function

 

[vbajock]

Put .update after your !Blob=varFileBinary, you are not updating your records.

On your record count issue, read this:

http://www.slxdeveloper.com/page.aspx?action=viewarticle&articleid=33

 

[vbajock]

BTW, the way your code is written, the number of records added will always be one.

 

[strongm]

>!FileName = Left(Mid(varFileName, InStrRev(varFileName, "\") + 1), InStrRev(Mid(varFileName, InStrRev(varFileName, "\") + 1), ".") - 1)
>!FileExt = Right(varFileName, Len(varFileName) - InStrRev(varFileName, "."))

Still think you'd be better off with the FileSystemObject version of this:

[blue]With CreateObject("scripting.filesystemobject")
    !FileName = .GetBaseName(varFileName)
    !FileExt = .GetExtensionName(varFileName)
End With[/blue]

And I'd query why you are opening a completely new connection to the database and recordset (given you already have tblBlob open) before making any suggestions about why your code is not doing what you expect ...

 

[patriciaxxx]

I am only learning access vba coding and seek help from more advanced coders on this forum like yourselves

I am not surprised to here my code could be written better and would much appreciate and learn from it if you would be good enough to post a working example

But your solution will need to sort out the two problems also

 

[Golom]

Function InsertBLOB(varFileName As Variant) As Boolean
'Inserts BLOB to file from table tblBLOB
On Error GoTo Got_An_Error

Dim objStream                  As ADODB.Stream
Dim rs                         As ADODB.Recordset
Dim varFileBinary              As Variant
Dim strConn                    As String

Set objStream = New ADODB.Stream
With objStream
    .Type = adTypeBinary
    .Open
    .LoadFromFile varFileName
    varFileBinary = .Read
    .Close
End With
Set objStream = Nothing

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
          CurrentProject.path & "\" & CurrentProject.Name

Set rs = New ADODB.Recordset
[b][red]' NOTE: This inserts ONLY ONE record![/red][/b]
With rs
    .Open "Select * from tblBlob", _
          strConn, adOpenKeyset, adLockOptimistic
    .AddNew
    With CreateObject("Scripting.FileSystemObject")
        rs![Filename] = .GetBaseName(varFileName)
        rs![FileExt] = .GetExtensionName(varFileName)
    End With
    ![Blob] = varFileBinary
    .Update
    .Close
End With

InsertBLOB = True

CloseUp:
Set rs = Nothing
Exit Function

Got_An_Error:
MsgBox Err.Number & " - " & Err.Description
InsertBLOB = False
Resume CloseUp

End Function

 

[strongm]

This is just a quick modification. Should ensure that recordcount is correctly updated on form.

[blue]Function InsertBLOB(varFileName As Variant) As Boolean
 [green]'Inserts BLOB to file from table tblBLOB[/green]
 On Error GoTo CloseUp

 Dim objStream As Object 'ADODB.Stream
 Dim objCmd As Object 'ADODB.Command
 Dim varFileBinary
 Dim CurrentMark As Variant

 Set objStream = CreateObject("ADODB.Stream")
 objStream.Type = 1 'adTypeBinary
 objStream.Open
 objStream.LoadFromFile varFileName
 varFileBinary = objStream.Read
 objStream.Close
 Set objStream = Nothing

 [green]' Add one new record[/green]
 With Form_Form1.Recordset [green]' assuming we are calling from a button on Form1 as per OP, and that this function
                           ' is in a seperate code module. If it is in the form's module itself  we can simply say With Recordset[/green]
    CurrentMark = .Bookmark
    .AddNew
    !FileName = CreateObject("scripting.filesystemobject").GetBaseName(varFileName)
    !FileExt = CreateObject("scripting.filesystemobject").GetExtensionName(varFileName)
    !Blob = varFileBinary
    .Update
    .Bookmark = CurrentMark
 End With

 InsertBLOB = True

CloseUp:
 On Error Resume Next
 Set objStream = Nothing
 Set objCmd = Nothing

End Function[/blue]

 

[patriciaxxx]

Thank you very much for your time and effort
I have tried both code examples
Unfortunately the first wont compile and although I tried my best to change values etc and get it to compile I cant so that one was no good
The second did compile when I put my forms name in place of Form1 but it did not add any records and again whatever I tried to do with it I could not figure out why or how to get it to add records
By the way I could not see any sign of recordcount on either example
My code does at least add the records
I would love to know how to include a recordcount and have the form update without using my on demand button
I am also curios now reading your comments to see the correct working example of my code

 

[Golom]

As the comment from both Strongm and myself noted

[red]This inserts ONLY ONE record![/red]

so any "Recordcount" that it returns will always be one.

You probably need to put in some error trapping to report errors. As you have it with the code that Strongm posted, an error is essentially ignored. If you hit an error the routine just terminates silently and you are never told why.

 

[strongm]

>with the code that Strongm posted

Which is just a minor change to Patricia's code - that's the code that has the general error trap. As I said earlier on there are a lot of issues with the code as shown.


>The second did compile when I put my forms name in place of Form1 but it did not add any records

Well ... yes ... that's why I put in the comment: [green]' assuming we are calling from a button on Form1 as per OP[/green]

It also assumes that, as you stated in the OP, that form is bound to the correct table (tblBlob). If these two assumptions are correct my code definitely adds a record (one) to tblBlob. If you cannot see it or a relevant recordcount on the form, then I'd hazard that that is a problem with the form, or some code associated with the form that you have not shown us.

 

[Golom]

Strongm

Well yes ... it does have a "general error trap" ... which just blows you out of the function without telling you that there was an error. Before I started looking elsewhere I would want to know that the code on this routine was getting to the part where the adding takes place. The fact that nothing is being added implies that it isn't.

 

[patriciaxxx]

Thank you very much for your comments

I have constructed the following code from your examples which sits in a module and is called from the form. The code does work and I hope it is correct by your standards.

Function InsertBLOB(varFileName As Variant) As Boolean
'Inserts BLOB to file from table tblBLOB
On Error GoTo CloseUp

Dim varFileBinary
Dim objStream As Object 'ADODB.Stream
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary
objStream.Open
objStream.LoadFromFile varFileName
varFileBinary = objStream.Read
objStream.Close
Set objStream = Nothing


Dim rst As Object 'ADODB.Recordset
Set rst = CreateObject("ADODB.Recordset")
With rst
.Open "Select * from tblBlob", _
CurrentProject.Connection, 1, 3
.AddNew
!FileName = Left(Mid(varFileName, InStrRev(varFileName, "\") + 1), InStrRev(Mid(varFileName, InStrRev(varFileName, "\") + 1), ".") - 1)
!FileExt = Right(varFileName, Len(varFileName) - InStrRev(varFileName, "."))
!Blob = varFileBinary
.Update
.Close
End With

Set rst = Nothing

InsertBLOB = True

CloseUp:
On Error Resume Next
Set objStream = Nothing

End Function

This is the code behind the button on the form. The forms record source is set to tblBlob

Private Sub cmdLoad_Click()
Dim fDialog As Office.FileDialog
Dim varFile As Variant

'Set up the File dialog box.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Allow the user to make multiple selections in the dialog box.
.AllowMultiSelect = True

'Set the title of the dialog box.
.TITLE = "Select One or More Files"

'Clear out the current filters, and then add your own.
.Filters.Clear
.Filters.Add "Access Databases", "*.MDB"
.Filters.Add "Access Projects", "*.ADP"
.Filters.Add "All Files", "*.*"

'Show the dialog box. If the .Show method returns True, the
'user picked at least one file. If the .Show method returns
'False, the user clicked Cancel.
If .Show = True Then
'Loop through each file that is selected and then add it to the list box.
For Each varFile In .SelectedItems
InsertBLOB varFile
Next
MsgBox .SelectedItems.Count
Me.Requery
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With

End Sub

I have now accomplished a count of records entered however the Me.Requery sometimes shows the new records added and sometimes doesn’t seems not to be very robust in its working. The separate on demand button which executes the same code Me.Requery always works very strange that it doesn’t always work in the Private Sub cmdLoad_Click()

If anyone knows how to correct this I would be very grateful
Similarly if I have made errors in my code by your standards I would be grateful for the corrections

 

[strongm]

>I have constructed the following code from your examples
>if I have made errors in my code by your standards

Um ... you don't seem to have taken on board either my or golom's suggestions. Did you post the wrong thing?

So, the Form code. I've merely removed the Requery, as you should not need it:

[blue]Option Compare Database
Option Explicit

Private Sub cmdLoad_Click()
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant
    
    'Set up the File dialog box.
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        'Allow the user to make multiple selections in the dialog box.
        .AllowMultiSelect = True
        
        'Set the title of the dialog box.
        .TITLE = "Select One or More Files"
        
        'Clear out the current filters, and then add your own.
        .Filters.Clear
        .Filters.Add "Access Databases", "*.MDB"
        .Filters.Add "Access Projects", "*.ADP"
        .Filters.Add "All Files", "*.*"
        
        'Show the dialog box. If the .Show method returns True, the
        'user picked at least one file. If the .Show method returns
        'False, the user clicked Cancel.
        If .Show = True Then
            'Loop through each file that is selected and then add it to the list box.
            For Each varFile In .SelectedItems
                InsertBLOB varFile
            Next
            MsgBox .SelectedItems.Count
        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
    End With

End Sub[/blue]

and the module code (although you could put it in the form, whci would streamline it a little bit more; see the comment in the code):

[blue][green]' Ensure you have a reference to Microsoft ActiveX Data 2.5 (or higher) Objects Library
' Inserts BLOB to file from table tblBLOB[/green]
Function InsertBLOB(varFileName As Variant) As Boolean

On Error GoTo Got_An_Error

    Dim varFileBinary As Variant
    Dim CurrentMark As Variant
    
    With New ADODB.Stream
        .Type = adTypeBinary
        .Open
        .LoadFromFile varFileName
        varFileBinary = .Read
        .Close
    End With
    
    ' Add one new record
    With Form_Form3.Recordset [green]' where you need to replace Form_Form3 with your own form. As previously advised, if this code is in the form's module, then Form_<MyFormName>.Recordset can be replaced with Recordset[/green]
        CurrentMark = .Bookmark
        .AddNew
        !FileName = CreateObject("scripting.filesystemobject").GetBaseName(varFileName)
        !FileExt = CreateObject("scripting.filesystemobject").GetExtensionName(varFileName)
        !Blob = varFileBinary
        .Update
        .Bookmark = CurrentMark
    End With
    
    InsertBLOB = True
    
CloseUp:
    Exit Function

Got_An_Error:
    MsgBox Err.Number & " - " & Err.Description
    InsertBLOB = False
    Resume CloseUp
        
End Function[/blue]

 

[patriciaxxx]

Thank you

I am using your code because you have been good enough to explain to me it is the correct way it should be done

I too have deleted the module and placed your revised one in the form

I have added the active x

It all works but with the following problem

When the table has no records I get the following error 3021 no current record
I then comment out the 2 Bookmark values and it works however when there are records I can leave the Bookmark values in and it works are the Bookmark values important I don’t really understand what the code is doing would you be kind enough to put comments in the code explaining things.

 

[strongm]

[blue][green]' Ensure you have a reference to Microsoft ActiveX Data 2.5 (or higher) Objects Library
' Inserts BLOB to file from table tblBLOB[/green]
Function InsertBLOB(varFileName As Variant) As Boolean

On Error GoTo Got_An_Error

    Dim varFileBinary As Variant
    Dim CurrentMark As Variant
    
    With New ADODB.Stream
        .Type = adTypeBinary
        .Open
        .LoadFromFile varFileName
        varFileBinary = .Read
        .Close
    End With
    
    [green]' Add one new record[/green]
    With Recordset [red]' Use the recordset the form is using[/red]
        If .RecordCount > 0 Then CurrentMark = .Bookmark [red]' Save our current position in the recordset using a bookmark. If the recordset is empty, then don't bother (thus leaving CurrentMark empty)[/red]
        .AddNew [red]' Add a new empty record[/red]
        [red]' The filesystemobject - provided by Microsoft's scripting runtime library - has a number of useful methods for manipulating paths and filesnames, so let's use a couple of them[/red]
        !FileName = CreateObject("scripting.filesystemobject").GetBaseName(varFileName) [red]' use the filesystemobject's method for getting the base name of a file[/red]
        !FileExt = CreateObject("scripting.filesystemobject").GetExtensionName(varFileName) [red]' use the filesystemobject's method for getting the extension of a file[/red]
        !Blob = varFileBinary
        .Update [red]' Force update of recordset with new record[/red]
        If lenb(CurrentMark) Then [red]' If we were able to save a current position (this is a bit of a hack) ...[/red]
            .Bookmark = CurrentMark [red]' ... restore it. But take out all the Bookmark stuff if we just want to be seeing the most recently added record on the form[/red]
        Else
            .MoveFirst [red]' Otherwise this is the (new) first record, so move there[/red]
        End If
    End With
    
    InsertBLOB = True
    
CloseUp:
    Exit Function

Got_An_Error: [red]' This is a simple, generic error handler. You might want to put your own error handling here[/red]
    MsgBox Err.Number & " - " & Err.Description
    '[green] InsertBLOB = False [red]' Actually, we don't need this line[/red][/green]
    Resume CloseUp
        
End Function[/blue]

 

[patriciaxxx]

Thank you for your patience, time and help
Very educational
Can you just explain further for me the bookmark stuff as I have not seen it before and don’t understand it
Do I need the bookmark stuff or is it save to take it out
If it is and I do take it out do I need to put . MoveFirst after .Update

 

[lionelhill]

(1) Error handling. A nice tip I got was to add a line "resume" after the line "resume CloseUp". The second "resume" is never run, but has a jolly useful function in debugging. When something goes wrong and you get the MsgBox describing the error, instead of accepting the OK and running "resume CloseUp", you can break the code at this point, in which case you'll be taken to the VBA editor with the yellow marker on the line after the MsgBox. You can now drag down to the "resume" line, and step forwards (i.e. run only the resume) and it will take you to exactly the place where the error happened in your code. This is often quite handy.

(2) The bookmark stuff is entirely optional, but helps your final database user. It means that when they press the "Add records" button, their form doesn't suddenly leap to a different record, which can be disconcerting.

 

[patriciaxxx]

thank you

Good tip, and the Bookmark stuff makes more sense to me knowing what its for.

If I take the Bookmark etuff out do I need to put .MoveFirst after .Update or just leave it with the .Update

 

[strongm]

If you are taking the bookmark out you can also remove the MoveFirst (it isn't really needed even with the bookmarks; I just put it in to be explicit about what is happening)

 

[patriciaxxx]

Thank you all especially strongm for guiding me in the correct way to code this which I feel has now been accomplished with your help and patience