Inserting multiple pictures into Excel

[Bobby]

Many of my users receive multiple pictures in their email
(Outlook). Is there a way to insert these pictures into
Excel all at one time instead of having to copy and paste
each one. Most of the emails that they receive have at
least 10 pictures and it is very time consuming to do one
at a time.
Any help would be greatly appreciated.
BW

[Dave Peterson]

Do you copy and paste from Outlook or do you save the files from Outlook to a
folder.

If the former, I don't know if you can automate Outlook like that. If you don't
get help here, you may want to ask in one of the outlook newsgroups.

If you save the files to a folder, you could do something like:

Option Explicit
Sub import_pictures()

Dim curWks As Worksheet
Dim myFileNames As Variant
Dim fCtr As Long
Dim myPict As Picture
Dim destCell As Range
Dim pictHeight As Long
Dim myRatio As Double

Set curWks = Workbooks.Add(1).Worksheets(1)

pictHeight = CLng(Application.InputBox(prompt:="How many rows for each
Picture?", _
Title:="Rows per picture?", _
Default:=10, Type:=1))

If pictHeight = 0 Then
MsgBox "Ok, Quitting"
Exit Sub
End If

myFileNames = Application.GetOpenFilename _
(FileFilter:="All files, *.*", _
MultiSelect:=True)

If IsArray(myFileNames) Then
Application.ScreenUpdating = False
With curWks
Set destCell = .Range("a1")
For fCtr = LBound(myFileNames) To UBound(myFileNames)
Set myPict = curWks.Pictures.Insert(myFileNames(fCtr))
With myPict
myRatio = .Width / .Height
.Top = destCell.Top
.Height = destCell.Resize(pictHeight, 1).Height
.Width = .Height * myRatio
.ShapeRange.Line.DashStyle = msoLineSolid
End With
Set destCell = destCell.Offset(pictHeight, 0)
Next fCtr
End With
Application.ScreenUpdating = True
Else
MsgBox "Ok, Quitting"
Exit Sub
End If

End Sub

To try this out:
Hit alt-f11 to see the VBE (where macros live)
then hit ctrl-R to see the project explorer
right click on your project (should look like: VBAProject (yourfilename.xls))
select insert module.
paste it there

Then hit alt-F11 to get back to excel.

Then tools|macro|macros...
select the macro (import_pictures)
click on Run.

David McRitchie has some notes for getting started with macros at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

--

Dave Peterson
ec3...@msn.com

[CLR]

Hi Dave......

I am interested in this ability also and I tried the macro and it freezes on
my computer with the "Input Box" line and does not put the Input Box up for
entry of the number of rows.......did I do something wrong?

TIA
Vaya con Dios,
Chuck, CABGx3

"Dave Peterson" <ec3...@msn.com> wrote in message
news:3E1F6985...@msn.com...

[CLR]

Hi Dave again......

Sorry about that......problem was a word-wrap thing and I fixed it, but the
macro still only brings me up to the selection of a picture to insert and I
don't see any way to select more than one......and when I try to run it a
second time, it deletes the first picture it inserted.........what (else)
did I do wrong?

TIA
Vaya con Dios,
Chuck, CABGx3

"CLR" <crob...@tampabay.rr.com> wrote in message
news:Ow9#MjXuCHA.1960@TK2MSFTNGP11...

[Dave Peterson]

Sorry about the wordwrap. (I added it later and forgot to adjust the line
length.

But this here line:

myFileNames = Application.GetOpenFilename _
(FileFilter:="All files, *.*", _
MultiSelect:=True)

(especially the multiselect:=true, gives you the ability to click on one file,
ctrl click on subsequent and open multiple files all at once. (You can also
click on the first and shift click one one and each file between them will also
be selected.) The File|Open dialog also works this way so you can open more
than one file at a time.)

--

Dave Peterson
ec3...@msn.com

[CLR]

Hi Dave.......

That is Sooooooooo cool.......your macro really does a good job........when
I get big, I want to be able to write macros just like you.......

Thanks muchly.......

Vaya con Dios,
Chuck, CABGx3

"Dave Peterson" <ec3...@msn.com> wrote in message

news:3E20310E...@msn.com...

[Dave Peterson]

That one made me laugh. Glad it worked ok for you.

--

Dave Peterson
ec3...@msn.com