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