copying of mails in public folders

[Lynn]

hi,
how can i automate copying of mails from public folders to my C drive?
thanks

 

[Jim Vierra]

Ahh! You ask zee beeg qvestion. Zis is not a one word answer.

Starting here please: http://www.outlookcode.com/codedetail.aspx?id=629

 

[Lynn]

hi,
can you explain what does this code do?
thanks

 

[Lynn]

i have also got an error. run-time error '91'. object variable for with
block variable not set

 

[Jim Vierra]

Are you trying to keep your code a secret?

What code is it that causes this to happen?

I will get out my telescope and peer over your shoulder or... you could send
it along with the question.

 

[Jim Vierra]

Warning - Properly set up Corporate Exchange servers can and do block
copying of items in public folders that are secure or proprietary. If you
can't copy them manually then you cannot copy them programmatically.

 

[Lynn]

the error occurs at this code:
Set Mail_Courant = myOlApp.ActiveInspector.CurrentItem

 

[Lynn]

any idea?

 

[Sue Mosher [MVP-Outlook]]

Either you don't have an Inspector (i.e. item) window open or your myOlApp
object was not instantiated properly.

 

[Michael Bauer]

Hi Lynn,

in lack of knowing more about your code:

Set Mail_Courant = myOlApp.ActiveInspector.CurrentItem

Err 91 in this line means probably, that ActiveInspector is Nothing.
That is, there is no Inspector opened (a MailItem e.g.).

 

[Lynn]

hi guys,
i used the code as found in
http://www.outlookcode.com/codedetail.aspx?id=629

Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As
Long) As Long
Public Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub move_to_archive()
Dim Nom_Mail, Annee, Mois, Jour As String
Dim Reponse As Integer
Dim fs
Dim ProcID As Long
Chrono_Mail = ""
Set myOlApp = CreateObject("Outlook.Application")

Set myXlApp = CreateObject("Excel.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
Chemin = "C:\"
myXlApp.DefaultFilePath = Chemin
Set Mail_Courant = myOlApp.ActiveInspector.CurrentItem
MsgBox myOlApp.ActiveInspector.Name

Chrono_Mail = Mail_Courant.ReceivedTime
Nom_Mail = Replace(Chrono_Mail, "/", "")
Annee = Mid(Nom_Mail, 7, 2)
Mois = Mid(Nom_Mail, 3, 2)
Jour = Mid(Nom_Mail, 1, 2)
Nom_Mail = "Email_" & Annee & Mois & Jour & "_" & Mail_Courant.Subject
Nom_Mail = Replace(Nom_Mail, ":", "")
Nom_Mail = Replace(Nom_Mail, "/", " ")
Nom_Mail = Replace(Nom_Mail, "\", " ")
Nom_Mail = Replace(Nom_Mail, "?", " ")
Nom_Mail = Replace(Nom_Mail, "*", " ")
Nom_Mail = Replace(Nom_Mail, "<", " ")
Nom_Mail = Replace(Nom_Mail, ">", " ")
Nom_Mail = Replace(Nom_Mail, ".", " ")
Nom_Mail = Replace(Nom_Mail, Chr(34), " ")

myXlApp.DefaultFilePath = Chemin

fileSaveName = myXlApp.GetSaveAsFilename(Nom_Mail, _
fileFilter:="Message Format (*.msg), *.msg", Title:="Archivage Mail")
fileSaveName_Replace = fileSaveName
myXlApp.Quit
Set myXlApp = Nothing
If fileSaveName = "False" Then Exit Sub

If Len(fileSaveName) > 2 Then
If fs.FileExists(fileSaveName) Then
Reponse = MsgBox("Un fichier du même nom exite déjà !" &
Chr(13) _
& "Voulez-vous le remplacer ?" & Chr(13) & "Cliquez No pour
l'ouvrir", vbYesNoCancel, "Remplacer fichier")
Select Case Reponse
Case 6
Mail_Courant.SaveAs fileSaveName_Replace, olMSG
Mail_Courant.Close 1
Case 7
On Error Resume Next
ProcID = ShellExecute(hwnd, "open", fileSaveName,
vbNullString, "C:\", 1)
SetForegroundWindow (ProcID)
Set myOlApp = CreateObject("Outlook.Application")
Set Mail_Archive = myOlApp.ActiveInspector.CurrentItem
Chrono_Archive = Mail_Archive.ReceivedTime
Case Else: Exit Sub
End Select
Else: Mail_Courant.SaveAs fileSaveName, olMSG
End If

End If
End Sub

any idea?

 

[Jim Vierra]

How come it's in French? It was written in Canada or France and was built
on a non-english version of Office. You will have to translate all of the
calls to the english equivalents to run in an english speaking environemnt
as your computers have not been taught french - Internationalized - I
suspect.

--
Jim Vierra
hi guys,
i used the code as found in
http://www.outlookcode.com/codedetail.aspx?id=629

Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As
Long) As Long
Public Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub move_to_archive()
Dim Nom_Mail, Annee, Mois, Jour As String
Dim Reponse As Integer
Dim fs
Dim ProcID As Long
Chrono_Mail = ""
Set myOlApp = CreateObject("Outlook.Application")

Set myXlApp = CreateObject("Excel.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
Chemin = "C:\"
myXlApp.DefaultFilePath = Chemin
Set Mail_Courant = myOlApp.ActiveInspector.CurrentItem
MsgBox myOlApp.ActiveInspector.Name

Chrono_Mail = Mail_Courant.ReceivedTime
Nom_Mail = Replace(Chrono_Mail, "/", "")
Annee = Mid(Nom_Mail, 7, 2)
Mois = Mid(Nom_Mail, 3, 2)
Jour = Mid(Nom_Mail, 1, 2)
Nom_Mail = "Email_" & Annee & Mois & Jour & "_" & Mail_Courant.Subject
Nom_Mail = Replace(Nom_Mail, ":", "")
Nom_Mail = Replace(Nom_Mail, "/", " ")
Nom_Mail = Replace(Nom_Mail, "\", " ")
Nom_Mail = Replace(Nom_Mail, "?", " ")
Nom_Mail = Replace(Nom_Mail, "*", " ")
Nom_Mail = Replace(Nom_Mail, "<", " ")
Nom_Mail = Replace(Nom_Mail, ">", " ")
Nom_Mail = Replace(Nom_Mail, ".", " ")
Nom_Mail = Replace(Nom_Mail, Chr(34), " ")

myXlApp.DefaultFilePath = Chemin

fileSaveName = myXlApp.GetSaveAsFilename(Nom_Mail, _
fileFilter:="Message Format (*.msg), *.msg", Title:="Archivage Mail")
fileSaveName_Replace = fileSaveName
myXlApp.Quit
Set myXlApp = Nothing
If fileSaveName = "False" Then Exit Sub

If Len(fileSaveName) > 2 Then
If fs.FileExists(fileSaveName) Then
Reponse = MsgBox("Un fichier du même nom exite déjà !" &
Chr(13) _
& "Voulez-vous le remplacer ?" & Chr(13) & "Cliquez No pour
l'ouvrir", vbYesNoCancel, "Remplacer fichier")
Select Case Reponse
Case 6
Mail_Courant.SaveAs fileSaveName_Replace, olMSG
Mail_Courant.Close 1
Case 7
On Error Resume Next
ProcID = ShellExecute(hwnd, "open", fileSaveName,
vbNullString, "C:\", 1)
SetForegroundWindow (ProcID)
Set myOlApp = CreateObject("Outlook.Application")
Set Mail_Archive = myOlApp.ActiveInspector.CurrentItem
Chrono_Archive = Mail_Archive.ReceivedTime
Case Else: Exit Sub
End Select
Else: Mail_Courant.SaveAs fileSaveName, olMSG
End If

End If
End Sub

any idea?

 

[Lynn]

Jim Vierra,
i have not idea, this code was given to me by yourself.
is there any less complicated code out there?

 

[Jim Vierra]

I guess you misunderstood me. I was pointing you at a site that had code
available and much good information in response to your question about how
you might accomplish your task. If you get into the code the site has a lot
of excellent pointers on how to do things with Outlook.

If you just want a solution then I suggest serching for one of the companies
referenced on the site for a product that will do what you need. You could
also google for a solution.

 

[Michael Bauer]

Hi Lynn,

I think here are some misunderstandings. Please let´s try again

You´ve asked what the code, you was pointed to, is doing.

1) Well, it first expects, that there is an Inspector opened. E.g. if
you double click on an MailItem, then the item will be opened. The
window, this item is shown in, is called Inspector. The active window is
called ActiveInspector. That is, if there is no MailItem, ContactItem
(or whatever) window opened, there is also no ActiveInspector object.
This is *probably* the reason for the Error 91 in your scenario.

2) Then a file name is created from the current (shown) MailItem´s
ReceivedTime and Subject properties. Ok, there are some french words,
but that´s absolutely ok. You´re free, using the Ork´s language, if you
like doing so

The filename string could contain any, for a filename unallowed,
character. This case will be handled by all the Replace function calls.

3) Next step: The code uses an Excel mechanism, which lets you define
where a file should be saved. Unfortunately a similar one isn´t
available in Outlook.

4) And now I have to guess a little bit. Once uppon the time my teacher
told me about my terrible french - and she was right

I think, the user will be notified, if there is a same named file
existing already and (s)he has to decide, what has to be done.

The ShellExecute call opens the existing file, SetForeGroundWindow
brings it´s window on top.

I hope, this little explanations will be helpful for you.


--
Viele Grüße
Michael Bauer


hi guys,
i used the code as found in
http://www.outlookcode.com/codedetail.aspx?id=629

Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As
Long) As Long
Public Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub move_to_archive()
Dim Nom_Mail, Annee, Mois, Jour As String
Dim Reponse As Integer
Dim fs
Dim ProcID As Long
Chrono_Mail = ""
Set myOlApp = CreateObject("Outlook.Application")

Set myXlApp = CreateObject("Excel.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
Chemin = "C:\"
myXlApp.DefaultFilePath = Chemin
Set Mail_Courant = myOlApp.ActiveInspector.CurrentItem
MsgBox myOlApp.ActiveInspector.Name

Chrono_Mail = Mail_Courant.ReceivedTime
Nom_Mail = Replace(Chrono_Mail, "/", "")
Annee = Mid(Nom_Mail, 7, 2)
Mois = Mid(Nom_Mail, 3, 2)
Jour = Mid(Nom_Mail, 1, 2)
Nom_Mail = "Email_" & Annee & Mois & Jour & "_" & Mail_Courant.Subject
Nom_Mail = Replace(Nom_Mail, ":", "")
Nom_Mail = Replace(Nom_Mail, "/", " ")
Nom_Mail = Replace(Nom_Mail, "\", " ")
Nom_Mail = Replace(Nom_Mail, "?", " ")
Nom_Mail = Replace(Nom_Mail, "*", " ")
Nom_Mail = Replace(Nom_Mail, "<", " ")
Nom_Mail = Replace(Nom_Mail, ">", " ")
Nom_Mail = Replace(Nom_Mail, ".", " ")
Nom_Mail = Replace(Nom_Mail, Chr(34), " ")

myXlApp.DefaultFilePath = Chemin

fileSaveName = myXlApp.GetSaveAsFilename(Nom_Mail, _
fileFilter:="Message Format (*.msg), *.msg", Title:="Archivage Mail")
fileSaveName_Replace = fileSaveName
myXlApp.Quit
Set myXlApp = Nothing
If fileSaveName = "False" Then Exit Sub

If Len(fileSaveName) > 2 Then
If fs.FileExists(fileSaveName) Then
Reponse = MsgBox("Un fichier du même nom exite déjà !" &
Chr(13) _
& "Voulez-vous le remplacer ?" & Chr(13) & "Cliquez No pour
l'ouvrir", vbYesNoCancel, "Remplacer fichier")
Select Case Reponse
Case 6
Mail_Courant.SaveAs fileSaveName_Replace, olMSG
Mail_Courant.Close 1
Case 7
On Error Resume Next
ProcID = ShellExecute(hwnd, "open", fileSaveName,
vbNullString, "C:\", 1)
SetForegroundWindow (ProcID)
Set myOlApp = CreateObject("Outlook.Application")
Set Mail_Archive = myOlApp.ActiveInspector.CurrentItem
Chrono_Archive = Mail_Archive.ReceivedTime
Case Else: Exit Sub
End Select
Else: Mail_Courant.SaveAs fileSaveName, olMSG
End If

End If
End Sub

any idea?

 

[Lynn]

i am totally new to this. What should i do?