Solved

Related Question - Access 2013 - Not Printing Photos

Posted on 2014-04-28
19
487 Views
Last Modified: 2014-05-06
I got a great solution that downsizes photos for my access database from my question

However now the photos seem to rotate on their own (some rotate and others don't) in the on screen image object and in the image object on the report

When I open the .jpg in windows paint or view them in explorer as large icons they don't rotate.

Not sure why they are rotating in the Access Reports and forms.

Can anybody help with this

this is the code I'm using to downsize and re-number the photos:
Private Sub RemanePhotosBtn_Click()
    Dim sfile As String
    Dim sText As String
    Dim iFileNum As Integer

    Dim sFilea As String
    Dim sTexta As String
    Dim iFileNuma As Integer

    Dim FileNm As String, i As Integer, PathNmChck As Integer, DestPathNm As String, DestPathNmChck As Integer, OverWritePhotoYN As Integer
    
    Dim PhotoDate As Date, DateSelect As Integer, FileNmPrefixTxt As String
    Dim MnthTxt As String, DyTxt As String, YrTxt As String, iMax As Integer
    Dim FrFileTxt As String, ToFileTxt As String
    
    Dim StartNo  As Integer, EndNo As Integer
    
'04-24-2014--------------------Begin Change - Photo Resize

    Dim s As String
    Dim TempPath As String
    Dim x As Integer
    Dim Img As WIA.ImageFile
    Dim myfolder As Object
    Dim myfile As Object
    Dim myfolder1 As Object
    Dim myfile1 As Object
    Dim found As Integer
    
    Dim IP As ImageProcess
    Set IP = CreateObject("WIA.ImageProcess")
    IP.Filters.Add IP.FilterInfos("Scale").FilterID ' for reference added 04-28-2014 from http://msdn.microsoft.com/en-us/library/windows/desktop/ms630819(v=vs.85).aspx#itemScale
    
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    TempPath = Forms![0_masterdatafrm]![DefaultPathHdr] & "Photos\Resized\"
    If Dir(TempPath) = "" Then
        On Error Resume Next
            MkDir TempPath
        On Error GoTo 0
    End If
    
'04-24-2014--------------------End Change - Photo Resize
    DestPathNm = Forms![0_masterdatafrm]![DefaultPathHdr] & "Photos\"

    DestPathNmChck = MsgBox("Is this the Path Where You Want to Copy Photos To?" & vbNewLine & vbNewLine & DestPathNm, vbYesNo)
    If DestPathNmChck = 6 Then
    
    Else
       strMessage = "Select a directory"
       startDirectory = "My Computer" 'c:\program files"
       Set objFF = CreateObject("Shell.Application").BrowseForFolder(0, strMessage, &H1, "J:\") 'startDirectory)
       If Not objFF Is Nothing Then
        getdirectory = objFF.items.Item.Path
           DestPathNm = objFF.items.Item.Path
           MsgBox DestPathNm
       Else
        getdirectory = vbNullString
        MsgBox "No directory selected"
        Exit Sub
       End If
       Set objFF = Nothing
    End If
    
    If Right(DestPathNm, 1) = "\" Then
    Else
        DestPathNm = DestPathNm & "\"
    End If

On Error Resume Next
    sfile = CurrentProject.Path & "\PhotoRenamePath.txt"
On Error GoTo 0
            
    If FileExists(sfile) Then
        iFileNum = FreeFile
        Open sfile For Input As iFileNum
        Input #iFileNum, sText
        Close #iFileNum
    Else
        sText = "c:\0\" '"J:\" & Right(Year(Now()), 2) & " Jobs\"
    End If
    
    PathName = sText
    
    PathName = Forms![0_masterdatafrm]![DefaultPathHdr] & "Photos\raw photos\"
    
    PathNmChck = MsgBox("Is this the Path Where the Raw Photos Are?" & vbNewLine & vbNewLine & PathName, vbYesNo)
    If PathNmChck = 6 Then
    
    Else
       strMessage = "Select a directory"
       startDirectory = "My Computer" 'c:\program files"
       Set objFF = CreateObject("Shell.Application").BrowseForFolder(0, strMessage, &H1, "J:\") 'startDirectory)
       If Not objFF Is Nothing Then
        getdirectory = objFF.items.Item.Path
           PathName = objFF.items.Item.Path
           MsgBox PathName
       Else
        getdirectory = vbNullString
        MsgBox "No directory selected"
        Exit Sub
       End If
       Set objFF = Nothing
    End If
    
    If Right(PathName, 1) = "\" Then
    Else
        PathName = PathName & "\"
    End If
    
    GlobalPath = PathName
    
    'write pathname to a text file
    sText = GlobalPath
    iFileNum = FreeFile()
    Open sfile For Output As iFileNum
    Write #iFileNum, sText
    Close #iFileNum
    
On Error Resume Next
    sFilea = CurrentProject.Path & "\PhotoNamePrefix.txt"
On Error GoTo 0
            
    If FileExists(sFilea) Then
        iFileNuma = FreeFile
        Open sFilea For Input As iFileNuma
        Input #iFileNuma, sTexta
        Close #iFileNuma
    Else
        sTexta = "Photo" '"J:\" & Right(Year(Now()), 2) & " Jobs\"
    End If

    FileNmPrefixTxt = InputBox("What do You Want to Use as a File Name?" & vbNewLine & vbNewLine & "Makesure You Only Use Valid Filename Characfters", , sTexta)
    
    'write photo file prefix
    sTexta = FileNmPrefixTxt
    iFileNuma = FreeFile()
    Open sFilea For Output As iFileNuma
    Write #iFileNuma, sTexta
    Close #iFileNuma
    
    DateSelect = MsgBox("Do you Want to Use the File Save Date in the File Name, or a different Date?" & vbNewLine & vbNewLine & "Use Date Format 10/08/2012", vbYesNo)
    
    If DateSelect <> 6 Then PhotoDate = InputBox("What Date Do You Want to Use", , Now())
    
    StartNo = InputBox("Do you Want to Start with Photo number 1?", , 1)
    
    FileNm = Dir(PathName & "*.jpg")
    
    iMax = StartNo
    While FileNm <> ""
        FileNm = Dir()
        iMax = iMax + 1
    Wend
    
    FileNm = Dir(PathName & "*.jpg")
    
    i = StartNo
    While FileNm <> ""
    FileNm = Dir()
        i = i + 1
    Wend
    EndNo = i
        
    i = StartNo
    
    Me![RemanePhotosBtn].Caption = "Rename " & vbNewLine & i & " of " & EndNo - 1
    Me![RemanePhotosBtn].Requery
    
    FileNm = Dir(PathName & "*.jpg")
    While FileNm <> "" And i < EndNo
        
'04-24-2014--------------------Begin Change - Photo Resize
        'clean out old copies of this file in resized folder
        Set myfolder = fs.GetFolder(TempPath)
        For Each myfile In myfolder.Files
            If myfile = TempPath & FileNm Then fs.DeleteFile myfile.Path, True 'whack the file, force it to die
        Next myfile

        Set Img = CreateObject("WIA.ImageFile")
        Img.LoadFile (PathName & FileNm) 'load it in WIA
        IP.Filters(1).Properties("MaximumWidth") = Me.Controls("TempPhotoImage").Width * 16 * 96 / 1440 '96 dpi * control width / twips per inch
        IP.Filters(1).Properties("MaximumHeight") = Me.Controls("TempPhotoImage").Height * 16 * 96 / 1440 '96 dpi * control height / twips per inch
        Set Img = IP.Apply(Img)
        s = TempPath & FileNm
        Img.SaveFile (s)
        Set Img = Nothing

        If DateSelect = 6 Then PhotoDate = FileDateTime(PathName & FileNm)

            If Month(PhotoDate) < 10 Then
                MnthTxt = "0" & Month(PhotoDate)
            Else
                MnthTxt = Month(PhotoDate)
            End If

            If Day(PhotoDate) < 10 Then
                DyTxt = "0" & Day(PhotoDate)
            Else
                DyTxt = Day(PhotoDate)
            End If

            YrTxt = Year(PhotoDate)

            FrFileTxt = TempPath & FileNm
            
            ToFileTxt = DestPathNm & FileNmPrefixTxt & " " & MnthTxt & "-" & DyTxt & "-" & YrTxt & " " & String(Len(LTrim(str(iMax))) - Len(LTrim(str(i))) + 1, "0") & i & Right(FileNm, 4)
            
            Set myfolder1 = fs.GetFolder(DestPathNm)
            found = 0
            For Each myfile1 In myfolder1.Files
                If myfile1 = ToFileTxt Then found = 1 'fs.DeleteFile myfile.Path, True 'whack the file, force it to die
            Next myfile1
            
            If found = 1 Then
                OverWritePhotoYN = MsgBox("This Photo File Exists Do You Want to Over Write It?" & vbNewLine & vbNewLine & ToFileTxt, vbYesNo + vbNo)
                
                If OverWritePhotoYN = 6 Then
                    FileCopy FrFileTxt, ToFileTxt
                End If
            Else
                FileCopy FrFileTxt, ToFileTxt
            
            End If
                
        FileNm = Dir()
        i = i + 1
    
        Me![RemanePhotosBtn].Caption = "Rename " & vbNewLine & i & " of " & EndNo - 1
        Me![RemanePhotosBtn].Requery
        Me![TempPhotoImage].Requery
        Me.Repaint
                
'MsgBox TempPath & vbNewLine & vbNewLine & FileNm & vbNewLine & vbNewLine & i
    Wend

    Close #iFileNum
End Sub

Open in new window

Prior related question: http:Q_28409124.html
0
Comment
Question by:rogerdjr
  • 6
  • 4
  • 3
  • +2
19 Comments
 
LVL 84
Comment Utility
I don't use Access for things like this (it's sorta like using a Prius to delivery shingles to a job site), but the first thing that I'd check would be to insure that the Image control on the report is big enough to handle the picture, and that you have the settings correct on that. Access will try to manipulate the picture to get it to display correctly, and if your Image control isn't sized properly then it may be trying a "best fit" scenario.

So be sure that it's sized sufficiently, and check the settings on that Image control.
0
 

Author Comment

by:rogerdjr
Comment Utility
Thanks for the comment. Access has been easy for me to learn, it's versatile and it's what I have and what I know. If you know of a better tool I'm all ears. I'm not really a developer, I just create tools to do reports for my projects.

Regarding the images I found a nifty little routine on the web that pages through each photo and tells me all its properties:
Dim p 'As Property
Dim s as string
For Each p In Img.Properties
    s = p.Name & "(" & p.PropertyID & ") = "
    If p.IsVector Then
        s = s & "[vector data not emitted]"
    ElseIf p.Type = RationalImagePropertyType Then
        s = s & p.Value.Numerator & "/" & p.Value.Denominator
    ElseIf p.Type = StringImagePropertyType Then
        s = s & """" & p.Value & """"
    Else
        s = s & p.Value
    End If

    MsgBox i & vbNewLine & s & vbNewLine & p.Name
Next

Open in new window

And what this tells me is that the orientation property is 1 for photo #12 and 6 for photo #13 and access is turning photo #13 90 degrees left.

I revised the code to size each photo to maximum of 1" high by 1" wide, and my object boxes are 1.2083" high x 1.047" wide

It is a baffling problem that all started because the large 2-3MB photos that take in the field doing inspections won't print in access.

I've attached copies of the raw photos and the reduced photos.

Any help you can provide will be greatly appreciated.

Thanks
IMG-0938.JPG
IMG-0939.JPG
14003-MBA-Main-Bldg-CASp-04-10-2.JPG
14003-MBA-Main-Bldg-CASp-04-10-2.JPG
14003.000-01-CASp-ReportOverallR.pdf
0
 
LVL 15

Expert Comment

by:ericpete
Comment Utility
I'm going to take a stab at this -- and I don't think it has anything to do with your code. Rather, it has to do with the nature of the images you're giving it to process.

Digital cameras and their output are always horizontally oriented (like 35mm film used to be). You can turn the camera on its side and take a vertical picture, but to the camera, it's just a bunch of pixels, so it stores them in the same way.

Moves those files of pixels to a computer, and they're just files; Access doesn't know if it's supposed to be a horizontally-oriented photo (like 12 and 28) or a vertically oriented one (like 13-27).

So your application is doing exactly what you're telling it to do.

Personally, while this could be some interesting programming for someone a lot more adept at it than I (like LSMConsulting, for example), the fact that you have literally thousands of images suggests to me that you might save some hair by using two tools:

Photoscape is a free image editor I've become very fond of because it has a batch editor, and it's accurately resized at least 50 images at a time in seconds. It has a bunch of other features I've not taken the time to explore, but it's worth it just for the resizing. http://www.photoscape.org/ps/main/index.php

Lupas Rename was recommended to me for pretty much the same application you have; in my case, I get sequential photographs in bunches, and I have to be able to tell whether they're for projectA or projectCZ, and at the same time, I have to maintain the sequence. I've run it on WinXP, and have no reason to think it won't run on Windows 7.

ep
0
 
LVL 26

Expert Comment

by:Nick67
Comment Utility
I'll poke at little harder at it tomorrow about what the EXIF properties are and do and can be manipulated with WIA.  Something I read today suggest that the EXIF properties influence portrait & landscape.  We've resized 50,000+ images with this code since it entered production without iy EVER rotating the images.  But the control is proportioned  4x3 and almost all are taken landscape.  I am buried at the moment, but I'll do what I can
0
 
LVL 26

Expert Comment

by:Nick67
Comment Utility
Post a sample with images that get twisted and ones that don't as well.  That'll make it easier to hunt the problem down.  One thing I DON'T do is overwrite the original.  That may be one source of the grief.
0
 
LVL 26

Expert Comment

by:Nick67
Comment Utility
OK,
If you are using something that sets the EXIF orientation, WIA can haul that up to deal with it
The orientation PropertyID is 274 and has 4 possible values
1 is horizontal (the expected value)
3 is inverted (flip 180 degrees)
6 is rotated 90 degrees clockwise
8 is rotated 279 degrees clockwise.

So, "...and 6 for photo #13 and access is turning photo #13 90 degrees left."
So we need to build a check in to your routine that checks that property and applies the appropriate IP.Filters.Add IP.FilterInfos("Rotate").FilterID to git 'er done.

We had discussed building a check like that in your previous question.
@EricPete, @aikimark.  This asker was the inspiration for my last article.
@Scott.  WIA/VBA code works wickedly well to get hundreds of large images into a single Access report.

I'll see if I can build a sample.
0
 
LVL 15

Expert Comment

by:ericpete
Comment Utility
Nick,

If you can pull it off, more power to you... *grin*...

ep
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 26

Accepted Solution

by:
Nick67 earned 500 total points
Comment Utility
Works like a hot damn old son!
Dim up a WIA.property
Dim prpty As WIA.Property

Add the second filter
IP.Filters.Add IP.FilterInfos("RotateFlip").FilterID

and then set the rotation according to what it finds    
   For Each prpty In Img.Properties
        If prpty.PropertyID = 274 Then
            Select Case prpty.Value
                Case 1
                    IP.Filters(2).Properties("RotationAngle") = 0 'do nothing
                Case 3
                    IP.Filters(2).Properties("RotationAngle") = 180 'flip
                Case 6
                    IP.Filters(2).Properties("RotationAngle") = 90 'twist 90
                Case 8
                    IP.Filters(2).Properties("RotationAngle") = 270 'twist 270
            End Select                
        End If
    Next


Tested it with your image 13.
Original, the picture is sideways.
After the orientation check, it's turned the way you'd like
0
 
LVL 15

Expert Comment

by:ericpete
Comment Utility
Nick,

Brilliant. I'm filing this one away.

ep
0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
@Eric

I agree.  Nick introduced me to WIA in the prior related question.  As far as I'm concerned, he could do a whole series of article on WIA.  Really good stuff.
0
 

Author Closing Comment

by:rogerdjr
Comment Utility
Amazing - works like a dream!!!!!

I am very grateful - you made my life much easier!!!!!!
0
 
LVL 26

Expert Comment

by:Nick67
Comment Utility
I am sorry that I cannot get Access to like your REALLY big images.
When I have more time, I'll create a shim that spilts an arbitrarily large image into overlapping quarters and displays them in a subreport in place of a single image control.

That'd be elegant and eminently doable with the WIA tools to hand, but as noted, I am buried at the moment

I do pay attention to my past questions, so if you had dropped a note in the old one, saying you had a new, related question on the go, it wouldn't have taken it to getting to Neglected status before I saw it.

Glad it worked!

Nick67
0
 

Author Comment

by:rogerdjr
Comment Utility
Thanks

I did not know that you would get the comment on the old question.

You have been a big help and I cannot express how grateful I am.

I like the idea of breaking a large image up and look forward to your response on that one.

It's a bit less pressing than the photo process.

Thanks again I am learning a lot from the info you have been providing.
0
 
LVL 26

Expert Comment

by:Nick67
Comment Utility
When you are ready, post a new, related question.
@aikimark, where is the UI for posting a related question?
A Related question, when created correctly, flags all the previous posters that something new is on the go.

In the meantime, here is code that takes an image and splits it into 4, each 65% of the original, oriented on the 4 corners, so that in theory you'll be able to see the whole image with enough overlap to make sense of any text near the borders -- which is important to you.  The code makes sense in light of db samples I've posted in your questions.

Combine this with a condtional based on Img.height and Img.width, and you could get WIA to split images larger than X by Y to something that will then print.

Private Function SplitEm(PicPath As String, PictureID As Long)
'yes you could combine spliting and shrinking into one operation
'but what if you only want to split in certain circumstances?
'so I built a separate sub
Dim s As String
Dim BuiltPath As String
Dim TempPath As String
Dim x As Integer
Dim Img As WIA.ImageFile
Dim myfolder As Object
Dim myfile As Object
Dim DesiredDPI As Integer

Dim IP As ImageProcess
Set IP = CreateObject("WIA.ImageProcess")

IP.Filters.Add IP.FilterInfos("Crop").FilterID
            
BuiltPath = PicPath 'rs!Path 'where the original is
TempPath = CurrentProject.Path & "\Resized\" ' a place to store dynamically generated images

'ok, I'm going to create 4 images
'each of them will be 65% of the originals, oriented on each of the four corners
For x = 1 To 4
    Set Img = CreateObject("WIA.ImageFile")
    Img.LoadFile (BuiltPath) 'load the stored jpg in WIA
    Select Case x
        Case 1 'top left
            IP.Filters(1).Properties("Left") = 0
            IP.Filters(1).Properties("Top") = 0
            IP.Filters(1).Properties("Right") = Img.Width * 0.35
            IP.Filters(1).Properties("Bottom") = Img.Height * 0.35
        Case 2 'top right
            IP.Filters(1).Properties("Left") = Img.Width * 0.35
            IP.Filters(1).Properties("Top") = 0
            IP.Filters(1).Properties("Right") = 0
            IP.Filters(1).Properties("Bottom") = Img.Height * 0.35
        Case 3 'bottom left
            IP.Filters(1).Properties("Left") = 0
            IP.Filters(1).Properties("Top") = Img.Height * 0.35
            IP.Filters(1).Properties("Right") = Img.Width * 0.35
            IP.Filters(1).Properties("Bottom") = 0
        Case 4 'bottom right
            IP.Filters(1).Properties("Left") = Img.Width * 0.35
            IP.Filters(1).Properties("Top") = Img.Height * 0.35
            IP.Filters(1).Properties("Right") = 0
            IP.Filters(1).Properties("Bottom") = 0
    End Select

    Set Img = IP.Apply(Img)
    s = TempPath & PictureID & "-" & x & "-crop.jpg"
    Img.SaveFile (s)
    Set Img = Nothing
Next x
End Function

Open in new window

0
 

Author Comment

by:rogerdjr
Comment Utility
thanks
0

Featured Post

Get up to 2TB FREE CLOUD per backup license!

An exclusive Black Friday offer just for Expert Exchange audience! Buy any of our top-rated backup solutions & get up to 2TB free cloud per system! Perform local & cloud backup in the same step, and restore instantly—anytime, anywhere. Grab this deal now before it disappears!

Join & Write a Comment

Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now