Abdullah
03-28-2012, 12:42 PM
Hello,
With the help from people on this forum, I had a Word 2007 macro that when run would be walked to a folder containing JPG files, which it would then create a table from. Each row has 3 columns, the first containing information of the photo (name, camera used, date/time, file size), the second was left blank for the user to fill in, and the third column contained a small photo with a hyperlink to the actual picture file.
The problem I'm having is getting the correct date/time to show in the first column for each file. It seems like it is taking the EXIF information from the first photo and using it for every row entry (i.e. the date/time that the first photo was taken appears as the date/time that every photo was taken).
I'm not sure how to get the EXIF information to re-load properly in the loop I have.
The line that outputs the file info follows:
cel.Range.Text = pic.Name & vbCr & objExif.Tag(Model) & vbCr & objExif.Tag(DateTimeOriginal) & vbCr & pic.Size & " Bytes"
The entire subroutine is below
Sub threePPg()
'
' threePPg Macro
'
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.Rows.Delete
Selection.TypeBackspace
Application.DisplayAutoCompleteTips = True
ActiveDocument.AttachedTemplate.AutoTextEntries("3Ppg").Insert Where:= _
Selection.Range, RichText:=True
Selection.TypeBackspace
ActiveDocument.AttachedTemplate.AutoTextEntries("addmore").Insert Where:= _
Selection.Range, RichText:=True
Selection.TypeBackspace
'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
Dim pth As New MSComDlg.CommonDialog
Dim r As Integer
Dim t As Integer
Dim objExif As New ExifReader
Dim txtExifInfo As String
entry = 0
'Browse to folder
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
pname = .SelectedItems(1)
Else
MsgBox "You pressed Cancel"
Exit Sub
End If
End With
'file path for pictures
Set fso = New FileSystemObject
Set fol = fso.GetFolder(pname)
'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
'ActiveDocument.Tables(1).Rows(entry).Select
'entry = entry + 1
'gives reference to cell 1 then adds text
Set cel = roe.Cells(1)
cel.Range.Text = pic.Name
entry = entry + 1
objExif.Load pic.Path
'
'FILL IN THE CELL INFORMATION
'
'Selection.MoveDown Unit:=wdLine, Count:=4, Extend:=wdExtend
'Selection.Delete Unit:=wdCharacter, Count:=1
cel.Range.Text = pic.Name & vbCr & objExif.Tag(Model) & vbCr & objExif.Tag(DateTimeOriginal) & vbCr & pic.Size & " Bytes"
'gives reference to cell 3 then adds pic
Set cel = roe.Cells(3)
'add photo
Set ish = cel.Range.InlineShapes.AddPicture(FileName:=pic.Path, LinkToFile:=False, SaveWithDocument:=True)
'add hyperlink..."text" would place text as the hyperlink
Set MyLink = ActiveDocument.Range.Hyperlinks.Add(ish, pic.Name, , , "")
End If
Next
ActiveDocument.Tables(1).Rows(2).Delete
End Sub
Any help would be greatly appreciated,
With the help from people on this forum, I had a Word 2007 macro that when run would be walked to a folder containing JPG files, which it would then create a table from. Each row has 3 columns, the first containing information of the photo (name, camera used, date/time, file size), the second was left blank for the user to fill in, and the third column contained a small photo with a hyperlink to the actual picture file.
The problem I'm having is getting the correct date/time to show in the first column for each file. It seems like it is taking the EXIF information from the first photo and using it for every row entry (i.e. the date/time that the first photo was taken appears as the date/time that every photo was taken).
I'm not sure how to get the EXIF information to re-load properly in the loop I have.
The line that outputs the file info follows:
cel.Range.Text = pic.Name & vbCr & objExif.Tag(Model) & vbCr & objExif.Tag(DateTimeOriginal) & vbCr & pic.Size & " Bytes"
The entire subroutine is below
Sub threePPg()
'
' threePPg Macro
'
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.Rows.Delete
Selection.TypeBackspace
Application.DisplayAutoCompleteTips = True
ActiveDocument.AttachedTemplate.AutoTextEntries("3Ppg").Insert Where:= _
Selection.Range, RichText:=True
Selection.TypeBackspace
ActiveDocument.AttachedTemplate.AutoTextEntries("addmore").Insert Where:= _
Selection.Range, RichText:=True
Selection.TypeBackspace
'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
Dim pth As New MSComDlg.CommonDialog
Dim r As Integer
Dim t As Integer
Dim objExif As New ExifReader
Dim txtExifInfo As String
entry = 0
'Browse to folder
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
pname = .SelectedItems(1)
Else
MsgBox "You pressed Cancel"
Exit Sub
End If
End With
'file path for pictures
Set fso = New FileSystemObject
Set fol = fso.GetFolder(pname)
'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
'ActiveDocument.Tables(1).Rows(entry).Select
'entry = entry + 1
'gives reference to cell 1 then adds text
Set cel = roe.Cells(1)
cel.Range.Text = pic.Name
entry = entry + 1
objExif.Load pic.Path
'
'FILL IN THE CELL INFORMATION
'
'Selection.MoveDown Unit:=wdLine, Count:=4, Extend:=wdExtend
'Selection.Delete Unit:=wdCharacter, Count:=1
cel.Range.Text = pic.Name & vbCr & objExif.Tag(Model) & vbCr & objExif.Tag(DateTimeOriginal) & vbCr & pic.Size & " Bytes"
'gives reference to cell 3 then adds pic
Set cel = roe.Cells(3)
'add photo
Set ish = cel.Range.InlineShapes.AddPicture(FileName:=pic.Path, LinkToFile:=False, SaveWithDocument:=True)
'add hyperlink..."text" would place text as the hyperlink
Set MyLink = ActiveDocument.Range.Hyperlinks.Add(ish, pic.Name, , , "")
End If
Next
ActiveDocument.Tables(1).Rows(2).Delete
End Sub
Any help would be greatly appreciated,