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

R

rickyfong

Registered User.
Local time
Today, 15:44
Joined
Nov 25, 2010
Messages
199
I saw a demo that the user could copy and paste a JPG format file physically to ACCESS, and then something happened, and ACCESS could read the JPG length and width size (e.g. 1.3 meter length and 1.15 meter width) into 2 individual ACCESS cells which is acted the same as user input to that 2 clells. Is there anyone know this kind of technique?? Thanks!!
 
I got the following codes from internet, but I cannot run it successfully in ACCESS, any one can help?? Thanks Public Type Picture
Height As Integer
Width As Integer
End Type
Public Function GetWidthHeight(ByVal ImageFile As String) As Picture
Pic.ScaleMode = 3
Pic.AutoSize = True
Pic.Picture = LoadPicture(ImageFile)
Pic.Visible = False
GetWidthHeight.Width = Picture1.ScaleWidth
GetWidthHeight.Height = Picture1.ScaleHeight
End Sub
 
This was the code from the Link..
Code: 
Public Function getFileMetadata(fileFolder As String, fileNm As String, metadataType 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)

  [COLOR=Green] 'I WAS USING THIS FOR .JPG FILES[/COLOR]
    If metadataType = "photo" Then
       Dim cTxt as String
       cTxt = "Dimensions: " & objFolder.GetDetailsOf(objFolderItem, 26)
       cTxt = cTxt & vbCrLf & "Date Picture Taken: " & objFolder.GetDetailsOf(objFolderItem, 25)
       cTxt = cTxt & vbCrLf & "Camera Model: " & objFolder.GetDetailsOf(objFolderItem, 24)
       cTxt = cTxt & vbCrLf & "Type: " & objFolder.GetDetailsOf(objFolderItem, 2)
       cTxt = cTxt & vbCrLf & "Size: " & objFolder.GetDetailsOf(objFolderItem, 1)
       getFileMetadata = cTxt
     ElseIf metadataType = "DatePicTaken" Then
       getFileMetadata = objFolder.GetDetailsOf(objFolderItem, 25)
     Else
       getFileMetadata = objFolder.GetDetailsOf(objFolderItem, 1)
    End If

    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing

[COLOR=Green]'Properties and index:
'================
'0 Name
'1 Size
'2 Type
'3 Date Modified
'4 Date Created
'5 Date Accessed
'6 Attributes
'7 Status
'8 Owner
'9 Author
'10 Title
'11 Subject
'12 Category
'13 Pages
'14 Comments
'15 Copyright
'16 Artist
'17 Album Title
'18 YEAR
'19 Track Number
'20 Genre
'21 Duration
'22 Bit Rate
'23 Protected
'24 Camera Model
'25 Date Picture Taken
'26 Dimensions
'27
'28
'29 Episode Name
'30 Program Description
'31
'32 Audio sample size
'33 Audio sample rate
'34 Channels
'35 Company
'36 Description
'37 File Version
'38 Product Name
'39 Product Version
'40 Keywords[/COLOR]
End Function
 
Sorry! It seems is not what I expected! What I would like to have is the length and width of the image file but not the file size of it!! Thanks a lot and hoping anyone could help again!!
 
The property 31 seems to give the dimension of the image file.. It does not have a Name.. but I just tried the code, it gave me the file's dimension..
Code: 
? getFileMetadata("C:\Users\pef\Desktop\sShots\","step2.png")
?356 x 303?
Maybe you could use it too..
Code: 
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
    
[COLOR=Green]'    For intCtr = 0 To 40
'        cTxt = cTxt & objFolder.GetDetailsOf(objFolderItem, intCtr) & vbCrLf
'    Next[/COLOR]
    
    cTxt = cTxt & objFolder.GetDetailsOf(objFolderItem, 31)
    
    getFileMetadata = cTxt
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Function
 
I have put more statements and tried to call this function, but ACCESS complained that the filefolder string in call GETFILEMETADATA is BYREF and the reference type is not match", any idea?? Is that I have to predefined something before the Public function!!?? Thanks!!

Dim filefolder, filenm As String
filefolder = "c:\"
filenm = "abcde.jpg"
Call getFileMetadata(filefolder, filenm)
Me.T1 = cTxt
Me.T2 = getFileMetadata
 
Could you show the complete code? Including what you have in the Common module?
 
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, 31)

getFileMetadata = cTxt

Set objFolderItem = Nothing
Set objFolder = Nothing
Set objShell = Nothing
End Function

Private Sub Form_Open(Cancel As Integer)
Dim filefolder, filenm As String
filefolder = "c:\"
filenm = "abcde.jpg"
Call getFileMetadata(filefolder, filenm)
Me.T1 = cTxt
Me.T2 = getFileMetadata
End Sub

Thanks a lot!!
 
Call getFileMetadata(filefolder, filenm)


Access point to filefolder and complained that the filefolder string in call GETFILEMETADATA is BYREF and the reference type is not match"!!
 
Why are you Calling the Function? The function returns a String.. So you need to assign it to a Variable/Control...

Would you mind trying the code in Post#11?
 
Now the ACCESS 2003 said that the third statement Shell32.shell is not being defined!!:banghead:

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
    
'    For intCtr = 0 To 40
'        cTxt = cTxt & objFolder.GetDetailsOf(objFolderItem, intCtr) & vbCrLf
'    Next
    
    cTxt = cTxt & objFolder.GetDetailsOf(objFolderItem, 31)
    
    getFileMetadata = cTxt
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Function

Private Sub Form_Open(Cancel As Integer)
Me.T1 = getFileMetadata("C:\", "abcde.jpg")
End Sub
 
Did you make sure you added the reference to 'Microsoft Shell Controls and Automation'
 
I was not before! But I have just added and tested before login. :oThe result of me.T1 is empty!! And I also checked that the CTX is also empty!! I have run through all the statements posted before and nothing has happened. :banghead:Any idea?? :pThanks!!:)
 
Try adding a Breakpoint..

attachment.php
 
I know what's the problem. I changed 31 to 26, and I got a text instead of a figure.

Then I found another code but it gave me a instant error with error code 424. What's wrong with syntax in below statment....Thanks!!

Code: 
 For i = 0 To 34
 Wscript.Echo i & vbTab & arrHeaders(i) _
 & ": " & objFolder.GetDetailsOf(strFileName, i)
 Next
:)
 
or the following, still getting error 424.......

Code: 
Sub Main()
               For Each strFileName In objFolder.Items
            For i = 0 To 34
                Console.WriteLine (i & vbTab & arrHeaders(i) & ": " & objFolder.GetDetailsOf(strFileName, i))
            Next
        Next
 
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