J'ai adapté un petit script qui me permet de copier un fichier présent
dans un répertoire des Dossiers Publics d'Outlook vers un répertoire
local, qui fonctionne très bien.
Cependant, je voudrais ajouter une boucle qui me permette de faire la
même chose pour un nombre indéfini de fichiers présents dans ce
dossier Outlook, chaque fichier gardant son nom d'origine bien
entendu. Je ne maitrise pas assez les commandes Outlook. Merci
d'avance de votre aide précieuse.
Sub OpenOutlookURL()
Dim openstr As String
'Dim ol As Outlook.Application
'Dim olns As Outlook.NameSpace
Dim myfolder As Variant
'Dim xlfile As Outlook.DocumentItem
Dim FileName As String
Dim wb As Excel.Workbook
FileName = "Test.xls"
Set ol = GetObject("", "Outlook.Application")
Set olns = ol.GetNamespace("MAPI")
Set myfolder = olns.Folders("Dossiers Publics").Folders _
("Tous les dossiers publics").Folders("Fichiers")
Set xlfile = myfolder.Items(FileName)
xlfile.Display
Set wb = Workbooks(FileName)
Workbooks(FileName).SaveAs FileName:="c:\local\" & FileName,
FileFormat:=xlNormal
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
mousnynao
Bonjour,
Voici un exemple :
'******************************************************* Sub ListeFichier(ByVal oRepertoire)
Dim oDossier Dim Reponse
On Error Resume Next If (oRepertoire.Files.Count > 0) Then For Each oFichier In oRepertoire.Files 'instruction Next End If
End Sub '********************************************************
Cette partie de code est une routine de récursivité, mais pour ne pas brouiller les cartes, j'ai enlevé l'autre instruction qui appelait la récursivité.
Il faudra toutefois renommer les objets :)
@+ mousnynao!
-----Message d'origine----- Bonjour à tous,
J'ai adapté un petit script qui me permet de copier un fichier présent
dans un répertoire des Dossiers Publics d'Outlook vers un répertoire
local, qui fonctionne très bien. Cependant, je voudrais ajouter une boucle qui me permette de faire la
même chose pour un nombre indéfini de fichiers présents dans ce
dossier Outlook, chaque fichier gardant son nom d'origine bien
entendu. Je ne maitrise pas assez les commandes Outlook. Merci
d'avance de votre aide précieuse.
Sub OpenOutlookURL() Dim openstr As String 'Dim ol As Outlook.Application 'Dim olns As Outlook.NameSpace Dim myfolder As Variant 'Dim xlfile As Outlook.DocumentItem Dim FileName As String Dim wb As Excel.Workbook
FileName = "Test.xls"
Set ol = GetObject("", "Outlook.Application") Set olns = ol.GetNamespace("MAPI") Set myfolder = olns.Folders("Dossiers Publics").Folders _
("Tous les dossiers publics").Folders("Fichiers")
Set xlfile = myfolder.Items(FileName)
xlfile.Display Set wb = Workbooks(FileName) Workbooks(FileName).SaveAs FileName:="c:local" & FileName,
FileFormat:=xlNormal
End Sub .
Bonjour,
Voici un exemple :
'*******************************************************
Sub ListeFichier(ByVal oRepertoire)
Dim oDossier
Dim Reponse
On Error Resume Next
If (oRepertoire.Files.Count > 0) Then
For Each oFichier In oRepertoire.Files
'instruction
Next
End If
End Sub
'********************************************************
Cette partie de code est une routine de récursivité, mais
pour ne pas brouiller les cartes, j'ai enlevé l'autre
instruction qui appelait la récursivité.
Il faudra toutefois renommer les objets :)
@+
mousnynao!
-----Message d'origine-----
Bonjour à tous,
J'ai adapté un petit script qui me permet de copier un
fichier présent
dans un répertoire des Dossiers Publics d'Outlook vers
un répertoire
local, qui fonctionne très bien.
Cependant, je voudrais ajouter une boucle qui me
permette de faire la
même chose pour un nombre indéfini de fichiers présents
dans ce
dossier Outlook, chaque fichier gardant son nom
d'origine bien
entendu. Je ne maitrise pas assez les commandes Outlook.
Merci
d'avance de votre aide précieuse.
Sub OpenOutlookURL()
Dim openstr As String
'Dim ol As Outlook.Application
'Dim olns As Outlook.NameSpace
Dim myfolder As Variant
'Dim xlfile As Outlook.DocumentItem
Dim FileName As String
Dim wb As Excel.Workbook
FileName = "Test.xls"
Set ol = GetObject("", "Outlook.Application")
Set olns = ol.GetNamespace("MAPI")
Set myfolder = olns.Folders("Dossiers
Publics").Folders _
("Tous les dossiers publics").Folders("Fichiers")
Set xlfile = myfolder.Items(FileName)
xlfile.Display
Set wb = Workbooks(FileName)
Workbooks(FileName).SaveAs FileName:="c:local" &
FileName,
'******************************************************* Sub ListeFichier(ByVal oRepertoire)
Dim oDossier Dim Reponse
On Error Resume Next If (oRepertoire.Files.Count > 0) Then For Each oFichier In oRepertoire.Files 'instruction Next End If
End Sub '********************************************************
Cette partie de code est une routine de récursivité, mais pour ne pas brouiller les cartes, j'ai enlevé l'autre instruction qui appelait la récursivité.
Il faudra toutefois renommer les objets :)
@+ mousnynao!
-----Message d'origine----- Bonjour à tous,
J'ai adapté un petit script qui me permet de copier un fichier présent
dans un répertoire des Dossiers Publics d'Outlook vers un répertoire
local, qui fonctionne très bien. Cependant, je voudrais ajouter une boucle qui me permette de faire la
même chose pour un nombre indéfini de fichiers présents dans ce
dossier Outlook, chaque fichier gardant son nom d'origine bien
entendu. Je ne maitrise pas assez les commandes Outlook. Merci
d'avance de votre aide précieuse.
Sub OpenOutlookURL() Dim openstr As String 'Dim ol As Outlook.Application 'Dim olns As Outlook.NameSpace Dim myfolder As Variant 'Dim xlfile As Outlook.DocumentItem Dim FileName As String Dim wb As Excel.Workbook
FileName = "Test.xls"
Set ol = GetObject("", "Outlook.Application") Set olns = ol.GetNamespace("MAPI") Set myfolder = olns.Folders("Dossiers Publics").Folders _
("Tous les dossiers publics").Folders("Fichiers")
Set xlfile = myfolder.Items(FileName)
xlfile.Display Set wb = Workbooks(FileName) Workbooks(FileName).SaveAs FileName:="c:local" & FileName,
