Solved: Importing multiple .emf files into excel 2007

[owen_1987]

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

[p45cal]

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

[owen_1987]

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

[Kenneth Hobs]

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

Try:
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

[owen_1987]

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?

[Kenneth Hobs]

For (1), change:
pathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
To:
pathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Importing tests\Batchtesting\"
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.
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

[owen_1987]

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

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


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


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


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

[Kenneth Hobs]

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.

If Dir(emfFile) = "" Then Exit Sub 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:
pathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Importing tests\Batchtesting\" To:
pathDesktop = "C:\Documents and Settings\od\Desktop\Importing tests\Batchtesting\"