How to import JPG format picture size into ACCESS individual input cells

Okay I am :confused: do you want help with VBA code? The codes in post 19 & 20 are VBScript and VB.Net..
 
Sorry! I am working with ACCESS 2003, those so-called vBscript and VBP codes were getting from the internet. They are so smiilar to VBA:banghead:. Anyway, what I got from my initial coding is only wordings such as "Dimenion", "size" etc instead of figures. I don't understand why you can get a figure as such as your previous result. I cann't recall , it seems your result was something liked 324x335. Any idea??:D Thanks!!
 
Can you post a Stripped DB?

How to Upload a Stripped DB.

To create a Sample DB (to be uploaded for other users to examine); please follow the steps..

1. Create a backup of the file, before you proceed..
2. Delete all Forms/Queries/Reports that are not in Question (except the ones that are inter-related)
3. Delete auxiliary tables (that are hanging loose with no relationships).
4. If your table has 100,000 records, delete 99,990 records.
5. Replace the sensitive information like Telephone numbers/email with simple UPDATE queries.
6. Perform a 'Compact & Repair' it would have brought the Size down to measly KBs..
7. (If your Post count is less than 10 ZIP the file and) Upload it..

Finally, please include instructions of which Form/Query/Code we need to look at. The preferred Access version would be A2003-A2007 (.mdb files)
 
Here comes the DB !! Thanks!! And sorry for I don't know how to reduce the size of my JPG file. Please use any JPG you have with you !! Thanks again!!
 

Attachments

Sorry! Sir, it won't work in my ACCESS 2003!! :banghead:Am my ACCESS missing something??;)
 
Is that when I double click the readsize, figures should appear in T1 box?? If this is the case, it is not working in my ACCESS 2003. Am I missing something?? Thanks!!
 
When you open the Form it should have the Dimension in the TextBox.. However I have used the Control Source of the Text Box as..
Code: 
=getFileMetadata([COLOR=Red][B][CurrentProject].[Path] [/B][/COLOR]& "\","stock-photo-10435961-constructor-worker-with-spirit-level.JPG")
You can change the highlighted section, to the path you have the Image file.. Also the name of the image..
 
=getFileMetadata("c:\","stock-photo-10435961-constructor-worker-with-spirit-level.JPG")

I have changed to more ease look, and still using your filename. But still nothing appeared in T1.
 
Before, we were talking about to have a number 31 in the function, but why it is disappeared now!! I have changed to more ease look, and still using your filename. But still nothing appeared in T1
Code: 
getFileMetadata("c:\","stock-photo-10435961-constructor-worker-with-spirit-level.JPG")
.
 
Nothing has disappeared.. I am not sure why it would not work for you..

I put the function in a common Module..
Code: 
Option Compare Database

Public Function getFileMetadata(filefolder As String, filenm As String) As String
    Dim objShell As Shell32.shell
    Dim objFolder As Shell32.Folder
    Dim objFolderItem As Shell32.FolderItem
    Set objShell = New shell
    Set objFolder = objShell.NameSpace(filefolder)
    Set objFolderItem = objFolder.ParseName(filenm)
    Dim cTxt As String, intCtr As Integer
 
    cTxt = cTxt & objFolder.GetDetailsOf(objFolderItem, [COLOR=Red][B]31[/B][/COLOR])
    
    getFileMetadata = cTxt
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing

End Function
The Number is still there..
 
Hi! I finally find out where is the function, and I changed the 31 to 26. It works well now! The T1 finally showed me the demionsion. But I don't see why in my Access 2003 is 26 but not 31!!?? At last, just want to know why you have put the function in module instead in the VBA working place?? Anyway, thank you so much for this!!:p
 
Well finally you have it sorted.. Good Luck.. :)
 
Story seems not over yet! When I tried TIF format file, the statement also gave me the dimennsion of the file but in fact, it is not the real dimension of the file due to the structure of TIF. Below is another coding I got from the net, and I have run but no result show!! Is there anyone or experts can help!! Thanks a lot again!!

Code: 
Sub mmm()
Dim strFile As String     '文件名
Dim strFileType As String 'TIF标记
Dim iffsetIFD As Long     '第一个IFD的偏移量
Dim iCountDE As Integer   'DE的数量
Dim lWidth As Long        '图像宽度
Dim lHeight As Long       '图像高度
Dim Temp1 As Integer, Temp2 As Long, i As Integer, k As Integer
strFile = "c:\1.05-1.25.tif"
Open strFile For Binary As #1
strFileType = String(2, 0)
Get #1, , strFileType     '获取TIF标记
' If strFileType <> "II" And strFileType <> "MM" Then Close #1: Exit Sub
Get #1, , Temp1           '版本号废弃
Get #1, , iffsetIFD       '获取第一个IFD的偏移量
Seek #1, iffsetIFD + 1    '设置下一个读出位置为第一个IFD的偏移量
Get #1, , iCountDE        '获取第一个IFD中DE的数量
For i = 1 To iCountDE
MsgBox "dddd"
Get #1, , Temp1         '获取属性的标签编号
If Temp1 = 256 Then     '如果是图像宽
Get #1, , Temp1       '废弃
Get #1, , Temp2       '废弃
Get #1, , lWidth
k = k + 1
ElseIf Temp1 = 257 Then '如果是图像高
Get #1, , Temp1       '废弃
Get #1, , Temp2       '废弃
Get #1, , lHeight
k = k + 1
Else                    '否则这些数据废弃
Get #1, , Temp1
Get #1, , Temp2
Get #1, , Temp2
End If
If k = 2 Then Exit For
Next i
Close #1
Debug.Print "Width：" & lWidth & vbCrLf & "Heigth：" & lHeight
 
End Sub
 
Story seems not over yet! When I tried TIF format file, the statement also gave me the dimennsion of the file but in fact, it is not the real dimension of the file due to the structure of TIF. Below is another coding I got from the net, and I have run but no result show!! Is there anyone or experts can help!! Thanks a lot again!!

Code: 
Sub mmm()
Dim strFile As String     '文件名
Dim strFileType As String 'TIF标记
Dim iffsetIFD As Long     '第一个IFD的偏移量
Dim iCountDE As Integer   'DE的数量
Dim lWidth As Long        '图像宽度
Dim lHeight As Long       '图像高度
Dim Temp1 As Integer, Temp2 As Long, i As Integer, k As Integer
strFile = "c:\1.05-1.25.tif"
Open strFile For Binary As #1
strFileType = String(2, 0)
Get #1, , strFileType     '获取TIF标记
' If strFileType <> "II" And strFileType <> "MM" Then Close #1: Exit Sub
Get #1, , Temp1           '版本号废弃
Get #1, , iffsetIFD       '获取第一个IFD的偏移量
Seek #1, iffsetIFD + 1    '设置下一个读出位置为第一个IFD的偏移量
Get #1, , iCountDE        '获取第一个IFD中DE的数量
For i = 1 To iCountDE
MsgBox "dddd"
Get #1, , Temp1         '获取属性的标签编号
If Temp1 = 256 Then     '如果是图像宽
Get #1, , Temp1       '废弃
Get #1, , Temp2       '废弃
Get #1, , lWidth
k = k + 1
ElseIf Temp1 = 257 Then '如果是图像高
Get #1, , Temp1       '废弃
Get #1, , Temp2       '废弃
Get #1, , lHeight
k = k + 1
Else                    '否则这些数据废弃
Get #1, , Temp1
Get #1, , Temp2
Get #1, , Temp2
End If
If k = 2 Then Exit For
Next i
Close #1
Debug.Print "Width：" & lWidth & vbCrLf & "Heigth：" & lHeight
 
End Sub
 
Sorry! IT WORKS WELL now. I save the file in the wrong location! Thanks!! But the result is still not what I want, I want is the exact length and width of the file but not the dot length and dot width. Both previous and this coding simply give me the dot size but not the exact image size. I have go on to dig what I want.......Thanks again for your help!!
 
Admittedly I only use jpegs as the tiffs are generally massive 50MB. But once I read the file into a control, I do this:
Code: 
Function GetPictureWidth()
    With CodeContextObject
        GetPictureWidth = CInt(.[ImageControl].ImageWidth / 15)
    End With
End Function
Code: 
Function GetPictureHeight()
    With CodeContextObject
        GetPictureHeight = CInt(.[ImageControl].ImageHeight / 15)
    End With
End Function
I know the thumbnail proportions so I divided by 15 to get the correct values.

Simon
 
After a few days investigation, I got some ideas but lacking of concept and technique to find out the resoluation value inside the TIFF file structure.

In the previously VBA code, it could read out the TIFF pixal width (tagID 257) and pixal height (tagID 258) but not the file real width and height. The key conversion factor is the resoluation value which is stored in the tagID 282 accoding to some reading. In fact, for reading tagID 257 and 258 is simple, as their data type are all long whereas the tagID 282 is rational.

According to TIFF file structure, rational data type consists of 2 sets of 4 HEX data location as the numerator and denominator, and the record of tagID 282 only store the starting position of the first HEX positions instead of storing the values as 257 and 258.

My problem is I can read out the data, but I don't know whether is HEXdecimal, decimal or binary values. And I also checked that no values come closed to the resoluation value that is given.

Code: 
Sub mmm()
Dim strFile As String     '文件名
Dim strFileType As String 'TIF标记
Dim iffsetIFD As Long     '第一个IFD的偏移量
Dim iCountDE As Integer   'DE的数量
Dim lWidth As Long        '图像宽度
Dim lHeight As Long       '图像高度
Dim TTID As Integer
Dim T1 As Long
Dim T99 As String
Dim Temp1 As Integer, Temp2 As Long, i As Integer, k As Integer
Dim temp3 As Long
Dim temp4 As Integer
Dim TEMP5 As Long
Dim TEMP6 As Long
Dim g1 As Integer
Dim G2 As Integer
Dim g3 As Integer
Dim g4 As Integer
Dim g5 As Integer
Dim g6 As Integer
Dim g7 As Integer
Dim g8 As Integer
Dim g9 As Integer
strFile = "C:\1.05-1.25.tif"
Open strFile For Binary As #1
strFileType = String(2, 0)
Get #1, , strFileType     '获取TIF标记
If strFileType <> "II" And strFileType <> "MM" Then Close #1: Exit Sub
Get #1, , Temp1           '版本号废弃
Get #1, , iffsetIFD       '获取第一个IFD的偏移量
Seek #1, iffsetIFD + 1    '设置下一个读出位置为第一个IFD的偏移量
Get #1, , iCountDE        '获取第一个IFD中DE的数量
MsgBox iffsetIFD
'For i = 1 To iCountDE
For i = 1 To 21
Get #1, , TTID   '获取属性的标签编号
If TTID = 256 Then     '如果是图像宽
Get #1, , Temp1       '废弃
Get #1, , Temp2       '废弃
Get #1, , temp3       '废弃
'
'Get #1, , lWidth
k = k + 1
'MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp3
ElseIf TTID = 257 Then '如果是图像高
Get #1, , Temp1       '废弃
Get #1, , Temp2       '废弃
Get #1, , temp3       '废弃
'Get #1, , lHeight
k = k + 1
'c
ElseIf TTID = 282 Then '如果是图像高
Get #1, , Temp1       '废弃
Get #1, , Temp2       '废弃
Get #1, , temp4
MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp4
Seek #1, temp4
T1 = temp4
Get #1, , g1       '废弃
Get #1, , G2       '废弃
Get #1, , g3       '废弃
Get #1, , g4       '废弃
Get #1, , g5       '废弃
Get #1, , g6       '废弃
Get #1, , g7       '废弃
Get #1, , g8       '废弃
'MsgBox TTID & " " & Hex(T1) & "= " & Hex(g1) & " " & Hex(G2) & " " & Hex(g3) & " " & Hex(g4) & " " & Hex(g5) & " " & Hex(g6) & " " & Hex(g7) & " " & Hex(g8)
MsgBox TTID & " " & T1 & "= " & g1 & " " & G2 & " " & g3 & " " & g4 & " " & g5 & " " & g6 & " " & g7 & " " & g8
Else                    '否则这些数据废弃
Get #1, , Temp1
Get #1, , Temp2
Get #1, , temp3
'MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp3
End If
'If k = 2 Then Exit For
Next i
Close #1
MsgBox "width：" & lWidth & vbCrLf & "height：" & lHeight & TID & T99

End Sub
 
You must log in or register to reply here.

Similar threads

S
Problem to run Access database
Replies
3
Views
378
mike60smart
mike60smart
L
Making a form to update multiple tables
Replies
6
Views
559
LakshinK
L
isladogs
Access Europe User Group - Wed 2 Apr: Class Modules: How, Why and When To Use Them in the Real World (Anders Ebro)
Replies
2
Views
472
isladogs
isladogs
Uncle Gizmo
My Journey: From Access/VBA to Building a Python AI Chat App (with LLM Help!)
Replies
6
Views
679
Shimon
S
P
SQL Server import into Access
Replies
6
Views
924
Minty
Minty

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom