S
sam
Guest
EXCEL-->OUTLOOK : ca marche !!!
Merci à biniouze pour ses conseils de recherche. Voici donc enfin après 2 jours de travail acharné une macro adaptée personnelle qui copie des fichiers excel (mais peut être adapté à d'autres types de fichiers) de c:\local\ vers un répertoire Outlook de votre choix, en tant que document office (et non en pièce jointe) :
' ************************************************
' POST TO OUTLOOK FOLDER *
' ************************************************
Sub AddDocumenttoInbox()
Set myOlApp = GetObject("", "Outlook.Application")
Set myNS = myOlApp.GetNamespace("MAPI")
Set MyFolder = myNS.PickFolder
'On Error Resume Next
Set objFolder = MyFolder
Set fs = Application.FileSearch
With fs
.LookIn = "c:\local"
.Filename = "*.xls"
For i = 1 To .FoundFiles.Count
Set objWordDoc = objFolder.Items.Add("IPM.Document.Excel.Document.5")
strPath = .FoundFiles(i)
poslash = InStrRev(strPath, "\")
nomcourt = Mid$(strPath, poslash + 1, Len(strPath))
longnomcourt = Len(nomcourt)
nomcourtfinal = Left$(nomcourt, Len(nomcourt) - 4)
nomcourtfinal2 = UCase(Left$(nomcourtfinal, 1)) & Mid$(nomcourtfinal, 2, 50)
With objWordDoc
.Subject = nomcourtfinal2 & ".xls"
.Attachments.Add (strPath)
.Save
End With
Next i
End With
End Sub
Merci à biniouze pour ses conseils de recherche. Voici donc enfin après 2 jours de travail acharné une macro adaptée personnelle qui copie des fichiers excel (mais peut être adapté à d'autres types de fichiers) de c:\local\ vers un répertoire Outlook de votre choix, en tant que document office (et non en pièce jointe) :
' ************************************************
' POST TO OUTLOOK FOLDER *
' ************************************************
Sub AddDocumenttoInbox()
Set myOlApp = GetObject("", "Outlook.Application")
Set myNS = myOlApp.GetNamespace("MAPI")
Set MyFolder = myNS.PickFolder
'On Error Resume Next
Set objFolder = MyFolder
Set fs = Application.FileSearch
With fs
.LookIn = "c:\local"
.Filename = "*.xls"
For i = 1 To .FoundFiles.Count
Set objWordDoc = objFolder.Items.Add("IPM.Document.Excel.Document.5")
strPath = .FoundFiles(i)
poslash = InStrRev(strPath, "\")
nomcourt = Mid$(strPath, poslash + 1, Len(strPath))
longnomcourt = Len(nomcourt)
nomcourtfinal = Left$(nomcourt, Len(nomcourt) - 4)
nomcourtfinal2 = UCase(Left$(nomcourtfinal, 1)) & Mid$(nomcourtfinal, 2, 50)
With objWordDoc
.Subject = nomcourtfinal2 & ".xls"
.Attachments.Add (strPath)
.Save
End With
Next i
End With
End Sub
