Solved: Importing multiple .emf files into excel 2007

Hi all,

I'm trying to import multiple .emf files from my desktop into a worksheet (one under the other) and then give them all an Alternative Text name "emf".

I have tried several times with no luck, can anyone help me constructing this?

Many thanks

Could you record yourself a macro doing this once or twice and post the result here?

i've tried to do this and it's not showing anything in the module, only "Macro 1"

Not sure why your recording failed. Mine was:
[vba] ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\ken\Desktop\Clipboard01.emf").Select[/VBA]

Try:
[vba]Sub InsertAllDesktopEMFs()
Dim pathDesktop As String, pic As Picture, emfFile As String, tlCell As Range
Set tlCell = Range("A1")
pathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
emfFile = Dir(pathDesktop & "*.emf")
Do While emfFile <> ""
tlCell.Select
Set pic = ActiveSheet.Pictures.Insert(pathDesktop & emfFile)
Set tlCell = Cells(pic.BottomRightCell.Row, pic.TopLeftCell.Column)
emfFile = Dir()
Loop
End Sub[/vba]

Thanks very much for that Kenneth, I have no idea why my macro recorder isn't functioning correctly.

I just have 2 further questions, if you don't mind;

By your VBA I understand that it is looking to get the emf from the desktop but is there any way I could build in a file path e.g C:\Documents and Settings\od\Desktop\Importing tests\Batchtesting ?

I also notice that it is a looped vba but I'm not sure how to loop it. My emfs are called 01.emf, 02.emf, 03.emf etc etc. Is there any code I can add to "Dir(pathDesktop & "*.emf")" to get it to scroll though the file numbers?

For (1), change:
[VBA]pathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator [/VBA]
To:
[VBA]pathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Importing tests\Batchtesting\"[/VBA]
You could hard code the whole path but other's Desktop are protected unless you have administrative rights.

It already loops and gets all EMF files. If you need a certain order, you could do a For loop and use Dir() to exit when the file does not exist. e.g.
[VBA]Sub InsertEMFs()
Dim pathDesktop As String, pic As Picture, emfFile As String, tlCell As Range
Dim i As Integer
Set tlCell = Range("A1")
pathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Importing tests\Batchtesting\"
For i = 1 To 99
emfFile = pathDesktop & Format(i, "0#") & ".emf"
If Dir(emfFile) = "" Then Exit Sub
tlCell.Select
Set pic = ActiveSheet.Pictures.Insert(pathDesktop & emfFile)
Set tlCell = Cells(pic.BottomRightCell.Row, pic.TopLeftCell.Column)
Next i
End Sub[/VBA]

Thanks again for your reply. I seem to still be having trouble with it though.

it's getting down to (the below) but then highlighting yellow

[vba]Set pic = ActiveSheet.Pictures.Insert(pathDesktop & emfFile)
Set tlCell = Cells(pic.BottomRightCell.Row, pic.TopLeftCell.Column)
[/vba]

but then it's showing an run time error '1004' - "Unable to get the insert property of the Picture class". Any ideas why it is doing this?

Where do I need to put
[vba]

pathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Importing tests\Batchtesting\"

[/vba]

Sorry for all the questions, I'm very new to this and trying to teach myself/ learn from others.

I showed the line of code to change in the Change From and Change To snippets. I then showed it all together in the last part using your last request for doing it by a prefix number. I guess that you put the code in a Module? I am not sure how I can explain it any better.

[vba]If Dir(emfFile) = "" Then Exit Sub [/vba] checks for the file's existence. Use F8 to step through your code to debug.

I guess that you can hard code the path in by changing:
[vba]pathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Importing tests\Batchtesting\" [/vba] To:
[vba]pathDesktop = "C:\Documents and Settings\od\Desktop\Importing tests\Batchtesting\"[/vba]