Adding code to create fldr to the "saving embedded graphics" macro??

[StargateFan]

The macro is this one that was so kindly given before:

"Sub SaveAttachment()
Dim objCurrentItem As Outlook.MailItem
Dim colAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment

Set objCurrentItem = Application.ActiveInspector.CurrentItem
Set colAttachments = objCurrentItem.Attachments
Set strFolderpath = CreateObject("WScript.Shell")

For Each objAttachment In colAttachments
objAttachment.SaveAsFile
("C:\WINDOWS\Desktop\YAHOOgroups\!Attachments saved from Outlook\" &
objAttachment.FileName)
Next

Set objAttachment = Nothing
Set colAttachments = Nothing
Set objCurrentItem = Nothing

End Sub"

The only problem is that I sometimes delete the folder without meaning
to. I've done that a couple of times. A few months back I then went
to save a bunch of embedded graphics only to come back a few days
later to find they weren't there (. And, of course, the emails were
gone. Any way to add a bit of code above to create the folder if the
folder doesn't already exist?

Thanks so much!

 

[Ken Slovak]

The way you're using that macro you don't need the scripting object at all.
Set strFolderpath = CreateObject("WScript.Shell") isn't needed in that
context since you are explicitly providing a save as path.

To see if a folder exists you can use the scripting object as follows:
Dim fso As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim strPath As String

Set fso = CreateObject("Scripting.FileSystemObject")
strPath = "C:\WINDOWS\Desktop\YAHOOgroups\!Attachments saved from
Outlook\"
If Not(fso.FolderExists(strPath)) Then
Set oFolder = fso.CreateFolder(strPath)
End If

 

[StargateFan]

The way you're using that macro you don't need the scripting object at all.
Set strFolderpath = CreateObject("WScript.Shell") isn't needed in that
context since you are explicitly providing a save as path.

Okay. I didn't write it, it was a code that was given to me.

To see if a folder exists you can use the scripting object as follows:
Dim fso As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim strPath As String

Set fso = CreateObject("Scripting.FileSystemObject")
strPath = "C:\WINDOWS\Desktop\YAHOOgroups\!Attachments saved from
Outlook\"
If Not(fso.FolderExists(strPath)) Then
Set oFolder = fso.CreateFolder(strPath)
End If

I created the macro and tried to use it. I got this error:

"User-defined type not defined."

What am I missing, pls?

***************************************
The macro reads like this (within the quotes):

"Sub SaveAttach2()

Dim fso As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim strPath As String

Set fso = CreateObject("Scripting.FileSystemObject")
strPath = "C:\WINDOWS\Desktop\YAHOOgroups\!Attachments saved from
Outlook\"
If Not (fso.FolderExists(strPath)) Then
Set oFolder = fso.CreateFolder(strPath)
End If
End Sub"

Thank you.

 

[Ken Slovak]

You most likely don't have a project reference set to the scripting runtime
(Scrrun.dll), which appears in the references list as Windows Scripting
Runtime. That would cause that error.

 

[StargateFan]

You most likely don't have a project reference set to the scripting runtime
(Scrrun.dll), which appears in the references list as Windows Scripting
Runtime. That would cause that error.

Wish I understood what you just said. <vbg> I'm just a power user, I
have no knowledge of these things, unfortunately. But anyway, bottom
line is that the script provided doesn't work as is? Unfortunately,
that the code that was given and I don't know how to fix it. <sigh>

Anyone have a working script they can share, by any chance, pls?

Again, the original code provided on a website that deals with saving
embedded graphics is this (within quotes only, of course):

"Sub SaveAttachment()
Dim objCurrentItem As Outlook.MailItem
Dim colAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment

Set objCurrentItem = Application.ActiveInspector.CurrentItem
Set colAttachments = objCurrentItem.Attachments
Set strFolderpath = CreateObject("WScript.Shell")

For Each objAttachment In colAttachments
objAttachment.SaveAsFile
("C:\WINDOWS\Desktop\YAHOOgroups\!Attachments saved from Outlook\" &
objAttachment.FileName)
Next

Set objAttachment = Nothing
Set colAttachments = Nothing
Set objCurrentItem = Nothing

End Sub"

I just need to add whatever is needed to the code above to create the
folder if it's not already there. So something that would take care
of checking for folder, creating it if not there or proceeding with
rest of script if it is.

 

[Ken Slovak - [MVP - Outlook]]

That original Web site code, wherever it is, it's not written very well...

Open your Outlook VBA project or whatever project your current code lives
in. Select Tools, References. In the list of libraries scroll down until you
see Windows Scripting Runtime. Check that and click OK. Your code should
then run without errors.

I have a somewhat similar procedure on my Web site, but it would have to be
modified to do what you want. The code I presented does what you want. My
Web site example is located at
http://www.slovaktech.com/code_samples.htm#StripAttachments

It almost looks as if my code sample was modified a little by someone who
didn't really understand it to come up with the code sample you have.

 

[StargateFan]

I'm addressing this issue again as the one kind suggestion given
before didn't work. The code below was provided by a kind poster in
this ng some time back and is from URL:
http://www.sparnaaij.net/howto/saveembeddedpictures.htm.

However, what I've run into is that if the folder isn't present, the
macro doesn't work in that the graphics aren't saved. I have a folder
which is now called "OutlookEmbeddedGraphics" on my desktop. Every
once in a while or after a new install after hdd wipe, I forget to
check whether it's there or not. In one particularly long session I
had saved graphics from 2 of my yahoo art groups only to realize that
the folder wasn't there and I lost all that work as I had deleted the
original email messages already.

Is there a modification to the coding below that will create the
"OutlookEmbeddedGraphics" folder on the desktop if it isn't there?

************************************************************
Sub SaveAttachment()
Dim objCurrentItem As Outlook.MailItem
Dim colAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment

Set objCurrentItem = Application.ActiveInspector.CurrentItem
Set colAttachments = objCurrentItem.Attachments
Set strFolderpath = CreateObject("WScript.Shell")

For Each objAttachment In colAttachments
objAttachment.SaveAsFile
("C:\WINDOWS\Desktop\OutlookEmbeddedGraphics\" &
objAttachment.FileName)
Next

Set objAttachment = Nothing
Set colAttachments = Nothing
Set objCurrentItem = Nothing

End Sub
************************************************************

Thanks much!

 

[StargateFan]

I'm addressing this issue again as the one kind suggestion given
before didn't work. The code below was provided by a kind poster in
this ng some time back and is from URL:
http://www.sparnaaij.net/howto/saveembeddedpictures.htm.

However, what I've run into is that if the folder isn't present, the
macro doesn't work in that the graphics aren't saved. I have a folder
which is now called "OutlookEmbeddedGraphics" on my desktop. Every
once in a while or after a new install after hdd wipe, I forget to
check whether it's there or not. In one particularly long session I
had saved graphics from 2 of my yahoo art groups only to realize that
the folder wasn't there and I lost all the embedded graphics I thought
I'd saved for our homework as I had deleted the original email
messages already.

Is there a modification to the coding below that will create the
"OutlookEmbeddedGraphics" folder on the desktop if it isn't there?

************************************************************
Sub SaveAttachment()
Dim objCurrentItem As Outlook.MailItem
Dim colAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment

Set objCurrentItem = Application.ActiveInspector.CurrentItem
Set colAttachments = objCurrentItem.Attachments
Set strFolderpath = CreateObject("WScript.Shell")

For Each objAttachment In colAttachments
objAttachment.SaveAsFile
("C:\WINDOWS\Desktop\OutlookEmbeddedGraphics\" &
objAttachment.FileName)
Next

Set objAttachment = Nothing
Set colAttachments = Nothing
Set objCurrentItem = Nothing

End Sub
************************************************************

Thanks much!

 

[Michael Bauer]

Hi,

easy to use is the FileSystemObject, which allows you to check for the
existing of any folder and create it if necessary. Please add a
reference to the "Microsoft Scripting Runtime" library to your project.

 

[StargateFan]

Hi,

easy to use is the FileSystemObject, which allows you to check for the
existing of any folder and create it if necessary. Please add a
reference to the "Microsoft Scripting Runtime" library to your project.

Hi, I'm not a programmer. Do you know of an example somewhere on the
net that shows exactly that? Thanks much for tip but it's Chinese to
me <g>.

Thanks.

 

[Michael Bauer]

Hi,

currently I don´t. Please google for: FileSystemObject VB [Outlook]. I´m
sure there are tons of samples.

 

[StargateFan]

Hi, I'm not a programmer. Do you know of an example somewhere on the
net that shows exactly that? Thanks much for tip but it's Chinese to
me <g>.

Hi.

Does anyone know how to add the FilesystemObject code to the code
below so that it works? Appreciate it. I've just again spent time
looking on the net but it's just so much wasted time. I really am not
a programmer (I wasn't kidding). I've managed to learn so much but
leaping ahead to something more advanced than I know how to do just
means for frustration and wasted time.

Thanks so much. Getting there slowly but surely, but still slowly.

--
Viele Grüße
Michael Bauer


news:[email protected]...

[snip]

[snip]