Results 1 to 3 of 3

Thread: Inserting Images Into a Word Document with VBA

  1. #1
    VBAX Regular
    Jul 2019

    Inserting Images Into a Word Document with VBA

    I'm reusing some VBA code to insert a batch of images into a Word document. The VBA creates a table and then inserts the images as well as a description above each image; which at the moment is the filename of the image.

    Sub AddPics()
        Application.ScreenUpdating = False
        Dim oTbl As Table, i As Long, j As Long, k As Long, StrTxt As String
        'Select and insert the Pics
        With Application.FileDialog(msoFileDialogFilePicker)
            .Title = "Select image files and click OK"
            .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
            .FilterIndex = 2
            If .Show = -1 Then
                'Add a 2-row by 2-column table with 7cm columns to take the images
                Set oTbl = Selection.Tables.Add(Selection.Range, 2, 2)
                With oTbl
                    .AutoFitBehavior (wdAutoFitFixed)
                    .Columns.Width = CentimetersToPoints(7)
                    'Format the rows
                    Call FormatRows(oTbl, 1)
                End With
                CaptionLabels.Add Name:="Picture"
                For i = 1 To .SelectedItems.Count
                    j = Int((i + 1) / 2) * 2 - 1
                    k = (i - 1) Mod 2 + 1
                    'Add extra rows as needed
                    If j > oTbl.Rows.Count Then
                        Call FormatRows(oTbl, j)
                    End If
                    'Insert the Picture
                    ActiveDocument.InlineShapes.AddPicture _
                    FileName:=.SelectedItems(i), LinkToFile:=False, _
                    SaveWithDocument:=True, Range:=oTbl.Rows(j).Cells(k).Range
                    'MsgBox (.SelectedItems(i).DateLastModified)
                    'Get the Image name for the Caption
                    StrTxt = Split(.SelectedItems(i), "\")(UBound(Split(.SelectedItems(i), "\")))
                    StrTxt = ": " & Split(StrTxt, ".")(0)
                    'Insert the Caption on the row below the picture
                    With oTbl.Rows(j + 1).Cells(k).Range
                        .InsertBefore vbCr
                        .Characters.First.InsertCaption _
                        Label:="Picture", Title:=StrTxt, _
                        Position:=wdCaptionPositionBelow, ExcludeLabel:=False
                        .Characters.First = vbNullString
                        .Characters.Last.Previous = vbNullString
                    End With
        End If
        End With
        Application.ScreenUpdating = True
        End Sub
        Sub FormatRows(oTbl As Table, x As Long)
        With oTbl
        With .Rows(x)
        .Height = CentimetersToPoints(7)
        .HeightRule = wdRowHeightExactly
        .Range.Style = "Normal"
        End With
        With .Rows(x + 1)
        .Height = CentimetersToPoints(0.75)
        .HeightRule = wdRowHeightExactly
        .Range.Style = "Caption"
        End With
        End With
    End Sub

    I'm not very familiar with the Application.FileDialog object. I'm still quite a novice with VBA in my opinion. Is there a way to pull the LastModifiedDate of each image and put that into the document in place of the filename as it is currently doing?
    Thank you

  2. #2
    VBAX Regular
    Jul 2019
    Fixed it with:

    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Debug.Print fs.GetFile(.SelectedItems(i)).DateLastModified

  3. #3
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Jul 2008
    Cross-posted (and solved by barneyos) at:
    Please read VBA Express' policy on Cross-Posting in Rule 3:
    Paul Edstein
    [MS MVP - Word]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts