Get Text from filename and insert into word document along with file

[rod602]

Greetings all,

I am thinking the following is possible. We have lots of files(images - jpegs); were we use a very description convention for a file name(ie. 'Image01 - Brown bunny jumping.jpeg'). We take these images and put them into word documents in a table. We end typing a caption under the image that just reflects the file name. Is there a macro, or script, that would facilitate just taking the text from the file name and putting it as a caption for that image that is inserted into the word document? Is this possible?

Any ideas?

Thanks all.

 

[jges]

The following script will take a folder of images and insert them into a table in Word (tested with Word 2007). Save the code to a text file, give it a name (change the extension to .vbs). To run it, drag and drop a folder (containing .jpg and/or .bmp images) onto the script file; or from the command line type: <name you gave script> <path to folder of images>. This version only looks for .jpg or .bmp files, and puts them in a 1 column table in a new Word file.

Change it around as you need, hope it helps!

set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(WScript.Arguments(0)) Then
  wscript.echo("Folder does not exist, script exiting")
  wscript.quit
End if

set objDic=createobject("scripting.dictionary")

  Set objFolder = objFSO.GetFolder(WScript.Arguments(0))
  Set colFiles = objFolder.Files
    for each objFile in colFiles
      strExt = LCase(objFSO.GetExtensionName(objFile))
      if (strExt = "jpg") or (strExt = "bmp") then
        dKey = objFile.Path
        if Not objDic.Exists(dKey) then
          caption = Mid(objFSO.GetBaseName(objFile), InStr(objFSO.GetBaseName(objFile), "-") + 1)
          caption = Trim(caption)
          objDic.Add dKey, caption
        end if
      end if
    next

  if objDic.Count <> 0 then

    set objWord = WScript.CreateObject("Word.Application")
    objWord.Visible = true
    set docNew = objWord.Documents.Add
    set tblNew = docNew.Tables.Add(objWord.Selection.Range, objDic.Count * 2, 1)
    tblNew.Borders.Enable = True

    row = 1
    for each key in objDic.Keys
      'wscript.echo("key: " & key & " , item: " & objDic.Item(key))
      tblNew.Cell(row, 1).Range.InlineShapes.AddPicture key, False, True
      row = row + 1
      tblNew.Cell(row, 1).Range.InsertAfter objDic.Item(key)
      row = row + 1
    next

  Else
    wscript.echo("No pictures in folder")

  End if

set objDic = nothing
set objFSO = nothing
wscript.echo("Done Processing")

 

[rod602]

@jges

Thank you so much for that code sample, I just tested and worked great in office 2010, win 7.

Here is my next question. The pictures are inserted full size. Is there a way of inserting say certain size. Say 300X300 pixels? Maybe re sizing after insertion or before insertion?

Thanks so much for the code sample.

 

[rod602]

@jges

Thank you so much for the code. I was able to tweak to meet my needs. The only issue I have at this point is the following. upon inserting the image caption I would like the auto-text( or auto correct) to replace the text. For example if an image was file name ppp.jpg and thus caption ppp. I have set up an auto-correct that will expand ppp into "protocols for people of Purple". And upon inserting of the text, that doesn't get replaced with the auto entry. Is there a way of making this happen?

Thanks so much.

 

[jges]

If you run the spell check after the script does it get corrected? If so, maybe add docNew.CheckSpelling to the end of the script and see if that helps.

 

[rod602]

@jges

No running spell check after the word document is generated doesn't make autotext replace the autotext entries. I tried your docNew.CheckSpelling and that didn't do it either.

Not sure where to go from here.

Thanks for all your help.
Rigo

 

[jges]

Might be a good question for the VBA forum. Perhaps someone with more experience with the Word object model can point you in the right direction. If there is a VBA solution, it is not difficult to translate that to VBScript (Word exposes the same objects to both, but there may be minor syntax differences between VBA and VBS).

 

[jges]

I had a bit of time this afternoon, so I looked into it some more. See how this works for you. The code assumes the words in the file name are separated by spaces ("title of picture") but can be changed to accomodate other delimiters ("title_of_picture", "title$of$picture", etc) if necessary. This version splits the title up into individual words and checks to see if there is an autocorrect entry for any of them.

set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(WScript.Arguments(0)) Then
  wscript.echo("Folder does not exist, script exiting")
  wscript.quit
End if

set objDic=createobject("scripting.dictionary")

  Set objFolder = objFSO.GetFolder(WScript.Arguments(0))
  Set colFiles = objFolder.Files
    for each objFile in colFiles
      strExt = LCase(objFSO.GetExtensionName(objFile))
      if (strExt = "jpg") or (strExt = "bmp") then
        dKey = objFile.Path
        if Not objDic.Exists(dKey) then
          caption = Mid(objFSO.GetBaseName(objFile), InStr(objFSO.GetBaseName(objFile), "-") + 1)
          caption = Trim(caption)
          objDic.Add dKey, caption
        end if
      end if
    next

  if objDic.Count <> 0 then

    set objWord = WScript.CreateObject("Word.Application")
    objWord.Visible = true
    set docNew = objWord.Documents.Add
    set tblNew = docNew.Tables.Add(objWord.Selection.Range, objDic.Count * 2, 1)
    tblNew.Borders.Enable = True

    row = 1
    for each key in objDic.Keys
      'wscript.echo("key: " & key & " , item: " & objDic.Item(key))
      tblNew.Cell(row, 1).Range.InlineShapes.AddPicture key, False, True
      row = row + 1
      'tblNew.Cell(row, 1).Range.InsertAfter objDic.Item(key)
      'split the title of the picture into individual words, assumes words are separated by spaces
      '  change this line if different delimiter is used (eg underscore character)
      strWords = Split(objDic.Item(key))
      'strWords = Split(objDic.Item(key), "<delimiter>")  'replace <delimiter> with actual delimiter used
      'check each word in the title - is it an autocorrect entry?
      for i = LBound(strWords) to UBound(strWords)
        for each acEntry in objWord.AutoCorrect.Entries
          if acEntry.Name = strWords(i) then
            'if the word is an autocorrect entry, replace it with the value
            strWords(i) = acEntry.Value
            Exit For
          end if
        next
      next
      'build the title back up from the array of words
      strTitle = ""
      for j = LBound(strWords) to UBound(strWords)
        if Len(strTitle) = 0 then
          strTitle = strWords(j)
        else
          strTitle = strTitle & " " & strWords(j)
        end if
      next
      'insert the autocorrected title
      tblNew.Cell(row, 1).Range.InsertAfter strTitle
      row = row + 1
    next

  Else
    wscript.echo("No pictures in folder")

  End if

set objDic = nothing
set objFSO = nothing
wscript.echo("Done Processing")

 

[rod602]

@jges

Wow! Just tried that work awesomely. Thank you so much for all your time and help.

Here is just a general question that is my next tasks. The code uses inlineshapes object to add pictures. Can yo use that same object to embedded pdf's or tiff files?

 

[jges]

Adding tiff files would be easy to do with the above code; change this line

if (strExt = "jpg") or (strExt = "bmp") then

to:

if (strExt = "jpg") or (strExt = "bmp") or (strExt = "tif") or (strExt = "tiff") then

I'm not sure about embedding pdf files, that's something I've not looked into yet.

 

[rod602]

Thank you.

Is there a good vbs reference online? Also a good ide for writing vbs scripts?

 

[jges]

This would be a good start:

http://msdn.microsoft.com/en-us/library/ms950396.aspx

I'll often refer to this site while scripting when I forget function names or parameters:

http://www.w3schools.com/vbscript/vbscript_ref_functions.asp

It also has tutorials and 'try it out' sections which is good for a quick test of a function.

http://www.w3schools.com/vbscript/default.asp

I've also seen this site recommended by other tek-tips members (thanks Geates):

http://raqxtr.sstar.com/caspdoc/html/vbscript_language_reference.htm

I don't know of a dedicated IDE for VBScript, but I like to use Notepad++ (with the language option set to VB so it will highlight key language words),

http://notepad-plus-plus.org/

It is a great notepad replacement, lots of useful features.

 

[rod602]

@jges

Thanks for the links. And info. I modified code a bit to scale images. I am putting 2 columns on the table; the issue I am encountering now is that the images are not always a particular size, so the code needs to handle different sizes properly. What I been doing is scaling the images, but doesn't doesn't always work out too good. Is there a way I can set the table column and rose size to static size so it doesn't change and set the images to autoresize so they match the size of cell?

The code below is where I am scaling. I can't find the function that allows me to just re size on the fly to fit the cell.

 tblNew.Cell(row, col).Range.InlineShapes.AddPicture key, False, True
	  tblNew.Cell(row, col).Range.InlineShapes(1).ScaleHeight = 30 ' have to standardize size of pictures in order to know what percent to scale properly. 
	  tblNew.Cell(row, col).Range.InlineShapes(1).ScaleWidth = 30

Thanks ,