Macro Incorporating JPEG Files

[Abdullah]

Hi Guys,

Not sure if writing a macro in word is the best way to do what I'm trying to accomplish. Essentially, I want to end up with a word file that has a table with 3 columns.

Column 1 will be info from a picture (i.e. name of file, date, time, etc) which I can supposedly get all the info from the metafile.
Column 2 will be a description of the photo (which will have to be written by a person going back and filling in).
And Column 3 will be a thumbnail of the file.

So essentially, I will have a folder filled with a variable number of jpeg files. I would like to run the program, have it automatically create the table and fill in columns 1 & 3 with the files' info/thumbnails.

I think that I can accomplish this with a word macro, but not 100% sure how to even begin this. I have a portion of code that creates the table (3 column set up), but don't know how to get info from metafiles/fill in/place a thumbnail.

Any help that anyone can offer will be greatly appreciated.

[TonyJollans]

There are several ways to do this - here is one to get you started. You will need a reference to "Windows Script Host Object Model".


Sub Abdullah()
Dim fso As FileSystemObject
Dim fol As Folder
Dim pic As File
Dim tbl As Table
Dim roe As Row
Dim cel As Cell
Dim ish As InlineShape
Set fso = New FileSystemObject
Set fol = fso.GetFolder("full\path\and\name\of\your\folder")
Set tbl = ActiveDocument.Range.Tables.Add(ActiveDocument.Range(0, 0), 1, 3)
For Each pic In fol.Files
If pic.Type = "JPEG Image" Then
Set roe = ActiveDocument.Tables(1).Rows.Add
Set cel = roe.Cells(1)
cel.Range.Text = pic.Name & vbCr & pic.DateCreated
Set cel = roe.Cells(3)
Set ish = cel.Range.InlineShapes.AddPicture(FileName:=pic.Path, LinkToFile:=False, SaveWithDocument:=True)
End If
Next
End Sub

[lucas]

Hi Tony,
I ran into this small issue that you should check if this doesn't work for you....this line:
If pic.Type = "JPEG Image" Then
did not work for me and when I checked the properties of the pictures I found that I had a graphics program that assigns a different property value to the jpegs. This is how mine were found:
If pic.Type = "Paint Shop Pro 7 Image" Then

[TonyJollans]

Oops!

I had literally just knocked that up for something very similar my wife wanted and simply changed it without thinking.

Safest way might be to check for the suffix...

If lcase(right(pic.path,4)) = ".jpg" or lcase(right(pic.path,5)) = ".jpeg"

[lucas]

That works great Tony. For the original poster you have to add an then to Tony's last code.

[Abdullah]

Hi Tony,

Sorry if I sound like a putz, but I how do I reference "Windows Script Host Object Model".

I assume not having done so is the reason I got the following,

Compile Error:
User-defined type not defined

-Thanks

[lucas]

Hi Abdullah,
In the Visual Basic Editor....go to tools-references...scroll almost to the bottom and put a check mark next to "Windows Script Host Object Model".

[Abdullah]

Lucas, Tony,

Thank you both very much, that is a huge help. Another question that I have is exactly what info is contained in the metafile. I'm trying to figure out what info I can incorporate into the first column (other than date/time). Is there a way to see what info about the pic the file contains?

Again, thank you guys very much, it works exteremely well.

[lucas]

Right click on the picture file in windows explorer and select properties.

[TonyJollans]

Not everything that appears in the Properties dialogue is available via the FileSystemObject. Depending what you want - and, I think, depending on your version of Windows - some things are harder than others.

[lucas]

Thanks Tony....I just tried a couple of them like file size before posting and had no problems so I jumped to the conclusion that they could be called.

[Abdullah]

Again, Thank you both very much, this was a HUGE help, especially since I had no idea how to even begin.

[TonyJollans]

My, I'm sure, our, pleasure!

[Abdullah]

Hi Guys,

So, I've tried editing what you have given me into more of a final product. But am having issues adjusting the formatting of the table.

Set tbl = ActiveDocument.Range.Tables.Add(ActiveDocument.Range(0, 0), 1, 3)

I know it inserts a blank row, but how would I fill in the blank fields with text explaining column content? How would I go about inserting a row of that at the top of every page?

I know that I would adjust the format of the cells in the IF THEN statement, but didn't actually figure out how. Trying to make column 2 wider, by setting the text to a different and smaller font.

Also, I tried just stripping the program so that I could add the pics in a file w/o the table (just for kicks). But ran into an issue...

Set ish = InlineShapes.AddPicture(FileName:=pic.Path, LinkToFile:=False, SaveWithDocument:=True)

Does not work, nor does AddPicture(etc). How would I go about that? For example if I had a table of a custom format, where I want a pic inserted into a field.

[TonyJollans]

Hi Abdullah,

Lot of questions there!


The code I posted was a bit sloppy, so one step at a time:
Set tbl = ActiveDocument.Range.Tables.Add(ActiveDocument.Range(0, 0), 1, 3)


This adds a 1-row, 3-column table at the start of the document and might have been slightly better written like this:
Set tbl = ActiveDocument.Range.Tables.Add(ActiveDocument.Range(0, 0), NumRows:=1, NumColumns:=3)

Next, within the loop, each picture is added to a new row. The line:
Set roe = ActiveDocument.Tables(1).Rows.Add


adds a row and gives you a reference to it. Next:
Set cel = roe.Cells(1)


gives you a reference to the first cell in the new row, and:
cel.Range.Text = pic.Name & vbCr & pic.DateCreated


puts text in that cell. It can be any text that you want. When the loop has finished there is an extra (unused) row at the top of the table that just wants deleting.

Now for changing it ... do you want a separate table at the top of each page, or do you want a single table with a heading row repeated at the top of each page? The latter is much easier.

As for adjusting individual columns you can reference columns the same way as you do cells (or rows), perhaps this:

tbl.Columns(3).Width = InchesToPoints(1)
tbl.Columns(2).Width = InchesToPoints(4)
to make column 3 narrower and column 2 wider.

Without more detail, I can't say what's wrong with your AddPicture, Sorry,

[Abdullah]

Tony,

I am trying to do the latter. Have a single table, but have a row at the top of each page as the header, a black background in only that row and white text in it, explaining the columns.

[TonyJollans]

Try this, after filling in the cells:

ActiveDocument.Tables(1).Rows(1).HeadingFormat = True

Adjust to refer to the appropriate table of course

[Abdullah]

Tony,

I can't refer to the table simply as

Set tbl = ActiveDocument.Range.Tables(1)

I put the line

ActiveDocument.Tables(1).Rows(1).HeadingFormat = True

in after I filled adjusted the column size and filled in the first row...but I am aparently not referencing the table/row correctly, because no matter how I try to reference it, it either doesn't fill in the row at the top of every page, or it gives me an error when trying to run.

[TonyJollans]

Sorry, I'm confused.

You say you can't use:

Set tbl = ActiveDocument.Range.Tables(1)

Why?

But you try to use:

ActiveDocument.Tables(1).Rows(1).HeadingFormat = True

which should work but you say sometimes gives you an error. What error?

Or, if not an error, how many pages is your table and do you simply get nothing? Does it work if you do it through the UI?

[Abdullah]

Tony,

The lines of code in the macro are as follows...

Set tbl = ActiveDocument.Range.Tables(1)
ActiveDocument.Tables(1).Rows(1).HeadingFormat = True

Which doesn't set a header for each page. I filled in the row, formatted the table to the way I want it. But I would like the first row to appear as the first row on every page. I intend to use this macro on multiple different folders...but currently I'm using a folder that creates a 5 page table once all the pics are filled in (other docs may be longer).

Unfortunately the first row doesn't appear on every page, not gettin an error, just not having it work the way I was hoping.

Does that explain it a little better?

[TonyJollans]

I'm sorry I don't know of any reason why that should fail. Can you post a sample document?

[Abdullah]

Tony,

A sample file is not attached, couldn't seem to get it under 19kb. But the first row is not the first row on every page (which is what I'm trying to do). The code is at the bottom, perhaps you could run it and see if it works as a header row for you.

Set tbl = ActiveDocument.Range.Tables(1)
ActiveDocument.Tables(1).Rows(1).HeadingFormat = True

doesn't seem to do anything



Also, as a few side notes, I've tried to make the text in column 1 smaller with

selection.font.size=10

but the font remains unaffected.



Also, I am trying to make the text only in the header rows centered...I'ved used a combination of

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
and
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft

But unfortunately my placement must be off or something, because I've been able to center just the text after the first line, leaving line 1 aligned to the left (the opposite of what I was trying to do).




Sub picinf()
'Variables
Dim fso As FileSystemObject
Dim fol As Folder
Dim pic As File
Dim tbl As Table
Dim roe As Row
Dim cel As Cell
Dim ish As InlineShape

'file path for pictures
Set fso = New FileSystemObject
Set fol = fso.GetFolder("C:\Documents and Settings\Administrator\My Documents\My Pictures\Copy of 4-11-2006")
'CREATING TABLE
'1 row 3 columns
Set tbl = ActiveDocument.Range.Tables.Add(ActiveDocument.Range(0, 0), NumRows:=1, NumColumns:=3)
'column sizes
tbl.Columns(1).Width = InchesToPoints(1.5)
tbl.Columns(2).Width = InchesToPoints(4)
tbl.Columns(3).Width = InchesToPoints(1.75)
'column labels
Set cel = ActiveDocument.Tables(1).Rows(1).Cells(1)
cel.Range.Text = "Info"
Set cel = ActiveDocument.Tables(1).Rows(1).Cells(2)
cel.Range.Text = "Description"
Set cel = ActiveDocument.Tables(1).Rows(1).Cells(3)
cel.Range.Text = "Picture"
'set row 1 as header for each page
Set tbl = ActiveDocument.Range.Tables(1)
ActiveDocument.Tables(1).Rows(1).HeadingFormat = True
'FILLING IN TABLE
For Each pic In fol.Files
If LCase(Right(pic.Path, 4)) = ".jpg" Or LCase(Right(pic.Path, 5)) = ".jpeg" Then
'add row and give reference to it
Set roe = ActiveDocument.Tables(1).Rows.Add
'gives reference to cell 1 then adds text
Set cel = roe.Cells(1)
cel.Range.Text = pic.Name & vbCr & pic.DateCreated
Set cel = roe.Cells(1)
Selection.Font.Size = 10
'gives reference to cell 3 then adds pic
Set cel = roe.Cells(3)
Set ish = cel.Range.InlineShapes.AddPicture(FileName:=pic.Path, LinkToFile:=False, SaveWithDocument:=True)
End If
Next
End Sub

[TonyJollans]

Odd! After running it if you look at the Table Menu you will see the row set as a Heading Row. I swapped it a few times and it eventually corrected itself - I don't know why at the moment. I have to go out now but will look at it later.

[Abdullah]

Tony,

I got the formating sorted out...including the header stuff.

The last thing that I have is, the program you started me off with....you had to type the file path into the code. Is there a way to have it set up where someone would run the macro, and have a prompt come up where they could step to the file path (similar to how file-open works)?

Thanks for all your help thus far, I can finally see the finish

[TonyJollans]

Glad you got it sorted. What was happening was that the Heading Row status was being set on the only row in the table. When new rows were added they inherited the status so that every row had it so it became something Word could not honour. The thing to do is to set it after there is at least one other row - in practice, after the loop building it the table.

[Abdullah]

Tony,

So for the prompt, I've determined that I need to reference Microsoft Common Dialogue Control and then use Show Open....I've tried making a form that I would edit, but that has confused and frustrated me.

How would you go about taking the hard coded file path out of the program and replacing it with a prompt that the user would use to step to the directory, or files?

[Abdullah]

Tony,

Please disreguard the previous post...I used an input box to request the correct path from the user, and it works alright. However, my question is, after running the program I ended up with a word file that was about 92Mb in size.

I believe the reason for that is because the program took shrunk down images of the files, instead of using the thumbnails. Do you know of a way I can use thumb nails instead of small images? In order to keep completed file size to minimum?

Also, to expand on that question, I noticed that the pictures don't completely fill the 3rd column cell. Is there a way to adjust the thumbnails (once they are thumbnails) to fit the exact cell size (even if it's writing the dimensions into the code)?

Please let me know...

Thank you,
Abdullah

[TonyJollans]

Sorry, I'm catching up slowly. Try this to pick up a folder. You'll want to take appropriate action and not just the msgboxes of course.

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
MsgBox .SelectedItems(1)
Else
MsgBox "You pressed Cancel"
End If
End With



As for compression - I'm not much of a picture person and don't know about VBA for this - try selecting a picture (any one), right clicking, selecting Format Picture and on the Picture tab, pressing Compress... Then choose to compress all pictures in document.

[TonyJollans]

AFAIK, you can't pick up thumbnails directly (do they necessarily exist anyway - or are they created in the fly?) but if you turn off autofit on the table (TableRef.AllowAutoFit= False) the pictures should be automatically scaled down to the width of the column (but will still want compressing). I don't think they'll scale up if the column is too wide though.

[Abdullah]

AFAIK? I dont know that anogram. Anyways, those both worked extremely well for me, both the browsing to the folder path and the auto-fit advice.

One last question, I know that currently I'm pulling the picture info that is displayed (date/time/name, etc) from the pic itself....i.e. get the same info by right clicking the picture and going to properties.

One thing I would also like to include is the camera make/model that took the picture. That info is not contained in the fields that show when you right click and go to properties, however is contained in the EXIF information. Do you know of a way for me to get at that info? Also, the date created info seems to be the date the pic was loaded on the computer (and some don't even show times). Do you know of a way to pull date/time from the EXIF information, in addition to the camera make/model?

[TonyJollans]

As Far As I Know. Having just formatted that I seem to recall there was a list of these somewhere on the site - I'll see if I can locate it.

Sorry I know nothing about extended properties of Images - If Windows can show them there's probably an API but I have no idea what it may be.

[Abdullah]

Tony,

Again, ignore the above post...except for the part where I ask about AFAIK. For a picture I figured out (when going to properties in the general tab) that the created field (also matches with picture taken, in the summary tab/advanced view) is the date it was loaded onto a computer, and the modified is when it was actually taken.

cel.Range.Text = pic.Name & vbCr & pic.DateCreated & vbCr & pic.Size & " Bytes"


I tried changing DateCreated to DateModified however that just throws a compile error at me. How would I go about making that change?

Also under properties ->summary -> advanced....it shows me the camera make and camera model. I need to encorporate those fields as well....so I was wondering if you knew how I could get the macro you'd greatly helped me with to output Modifed (for the correct picture taken time)(properies --> general) and equipment make (properies --> summary/advanced) and camera model (properies --> summary/advanced)

[Abdullah]

If you could find that list (of what info is available/how to reference it) that would be fantastic

[TonyJollans]

I've found the link to the glossary - http://www.vbaexpress.com/forum/glossary.php - but it appears the feature has been removed; I don't know why.

[Abdullah]

Tony,

You have no idea where I could possibly find another copy of the glossary? I'm done with the project...with the exception of the info added to the info column. Again, I was hoping to include the date modified instead of the date created, and the camera make/model that was used. A copy of the glossary of info I could include (what the fields are named) would be a HUGE help in finishing the project.

Thanks