[AccessD] trying to import an image is failing

Bill Benson bensonforums at gmail.com
Wed Jan 7 12:18:30 CST 2015


Access is refusing to import a small icon (or bmp) file that I have already
stored as an attachment in a table. My procedure - probably unnecessarily -
saves this small file out to a temp folder and then tries to import it back
into the database as the source for an image control. Upon the step that
says

             imgApplicationIcon.Picture = strPath

I get a message that the file is too big, try importing a bmp instead.  That
was when this tiny image was a .ico file

So I used paint and changed the .ico to a .bmp, and changed the SaveAs path
to use .bmp instead, and retried the assignment step - still getting that
message:

[Applicationname] doesn't support the format of the file [blah].bmp or the
file is too large. Try converting the file to a BMP format.

This is very strange, the file is tiny. The db that I copied this form and
its code from has no problems with the file, nor should it - as it is only
644k. Either as a ICO or a BMP. 

Has someone run into this type of error before and can explain what Access
may be thinking is really wrong?

The value of strpath is C:\Users\Bill
SSD\AppData\Local\Temp\2015_01_07_13_11_55___Temp.bmp

TIA!

Sub SetupHeaders(Optional Frm)
Dim D As DAO.Database
Dim r As DAO.Recordset
Dim SQL As String
Dim strTemp As String
Dim strPath As String
Dim strNow As String
Dim rsPic
Dim Ctrl As Control
Dim MyFrm As Form
Dim Lin As Control
Dim txtApplicationName  As Control
Dim txtBuildDate  As Control
Dim txtCopyright  As Control
Dim lblFormPurpose As Control
'Dim txtDeveloper  As Control
Dim txtVersionNumber  As Control
Dim CtrlContainer As Control
Dim imgApplicationIcon As Control

'All user-facing forms shall have these header controls

On Error GoTo exit_me
If IsMissing(Frm) Then
    Set MyFrm = Forms(Forms.Count - 1)
Else
    Set MyFrm = Forms(Frm.Name)
End If

With MyFrm
    Set txtApplicationName = .Controls(APPLICATION_NAME)
    Set txtBuildDate = .Controls(BUILDDATE)
    Set txtCopyright = .Controls(COPYRIGHT)
    'Set txtDeveloper = .Controls(DEVELOPER)
    Set txtVersionNumber = .Controls(AppVersion)
    Set imgApplicationIcon = .Controls(APPICON)
'    Set CtrlContainer = .Controls(BoxHeader)
'    Set Lin = .Controls(LINEUNDER)
End With

strNow = Format(Now(), "yyyy_mm_dd_hh_mm_ss")
On Error Resume Next
strTemp = MyTempFolder
If Err.Number <> 0 Or strTemp = "" Then
    MsgBox "Could not access routine 'MyTempFolder' in module
'mod_003_Functions'.", vbCritical
    GoTo exit_me
End If

strPath = strTemp & strNow & "___Temp.bmp"
Kill strPath
On Error GoTo 0


Set D = CurrentDb
SQL = ""
SQL = SQL & " SELECT First(ApplicationName) AS APPLICATION_NAME,"
SQL = SQL & " First(ApplicationVersion) AS AppVersion,"
SQL = SQL & " First(Copyright) AS AppCopyRight,"
SQL = SQL & " First(DeveloperLogo) AS AppDeveloperLogo,"
SQL = SQL & " First(DeveloperPicture) AS AppDeveloperPicture,"
SQL = SQL & " First([BuildDate]) AS AppBuildDate,"
SQL = SQL & " First(DeveloperName) AS AppDeveloperName,"
SQL = SQL & " First(DeveloperPhone) AS AppDeveloperPhone,"
SQL = SQL & " First(ApplicationImage) As AppImage"
SQL = SQL & " FROM [DevelopmentVersion]  as Tbl"
SQL = SQL & " WHERE "
SQL = SQL & " [BuildDate]=(Select Max([BuildDate]) from
[DevelopmentVersion]);"


Set r = D.OpenRecordset(SQL)

'txtApplicationName = ""
'txtBuildDate = ""
'txtCopyright = ""
'txtDeveloper = ""
'txtVersionNumber = ""

txtApplicationName = Nz(r.Fields("APPLICATION_NAME"), "")
txtBuildDate = Nz(r.Fields("AppBuildDate"), "")
txtCopyright = CStr(Nz(r.Fields("AppCopyright"), ""))
'txtDeveloper = Nz(r.Fields("AppDeveloper"), "")
txtVersionNumber = Nz(r.Fields("AppVersion"), "")
Set rsPic = r.Fields("AppImage").Value
'There is only one pic on the most up to date record so we don't need a loop
If Not rsPic.EOF Then
    On Error Resume Next
    Kill strPath
    On Error GoTo 0
    rsPic.Fields("FileData").SaveToFile strPath
End If
imgApplicationIcon.Picture = strPath

Kill strPath

On Error Resume Next
Set lblFormPurpose = MyFrm.Controls("lblFormPurpose")
'If lblFormPurpose Is Nothing Then
'    SetHeaderLine Lin
'Else
'    SetHeaderLine Lin, lblFormPurpose
'End If
GoTo exit_me


err_CouldNotSetImage:



GoTo exit_me


err_Missing_Specific_Controls:



On Error Resume Next
Kill strPath
On Error GoTo 0

exit_me:

End Sub




More information about the AccessD mailing list