0/5 (3 avis)
Vue 8 366 fois - Téléchargée 432 fois
'#################################################################### '# Author : Xavier Bourdeau (xav.bourdeau@free.fr # '# Program : Attachement Saver Version : 4.5.2 # '# # '# This VBA Macros will extract attachements from an outlook folder # '# (or recursive, since Version 3) & with criteria selection # '# Please share it, but don't modifiy it without notifying me and # '# sending me the new version. # '# # '# Thanks to David A. for idea and inspiration # '# # '#################################################################### 'You'll need those additional controls 'if you are missing one of them, you will need MSCOMCT2.OCX in C:\Windows\System32 folder 'You can download MSCOMCT2.OCX at http://support.microsoft.com/kb/297381 ' 'Microsoft Date and Time Picker Control 6.0 'Microsoft ProgressBar Control 6.0 'Microsoft TreeView Control 6.0 ' 'You may need to restart Outlook when controls are just added ' Public ProgressBarWidth As Integer Private Sub Bt_About_Click() 'Please do not edit this line, for the glory of I MsgBox "Attachement Saver" & vbCrLf & "This program is provided by Xavier Bourdeau" & vbCrLf & "Please send me bugs, comment and donation :o)", vbInformation, "About this little program" End Sub Private Sub Bt_Cancel_Click() 'Good bye Unload Me End Sub Private Sub Bt_Export_Click() Dim Temp As Variant Temp = BrowseForFolder If Temp = False Then Exit Sub TextBox_Dir = Temp End Sub Public Function FileOrFolderExists(FullPathFile As String) As Boolean 'This function return TRUE if the file or folder exists, and return FALSE if it does not exist On Error GoTo argh 'ok ok, it's not beautifull, but work so fine, because DIR function has a lot of limitations, onerror manage all the others If Not Dir(FullPathFile, vbDirectory) = vbNullString Then FileOrFolderExists = True Exit Function argh: FileOrFolderExists = False On Error GoTo 0 End Function Private Sub CB_FileType_Change() TB_FileType = "" If CB_FileType = "Office docs" Then TB_FileType = "*.xls;*.xlsx;*.doc;*.docx;*.pps;*.ppt;*.ppsx;*.pptx" If CB_FileType = "Excel" Then TB_FileType = "*.xls;*.xlsx" If CB_FileType = "Word" Then TB_FileType = "*.doc;*.docx" If CB_FileType = "PowerPoint" Then TB_FileType = "*.pps;*.ppt;*.ppsx;*.pptx" If CB_FileType = "PDF" Then TB_FileType = "*.pdf" If CB_FileType = "Pictures" Then TB_FileType = "*.jpg;*.jpeg;*.bmp;*.gif;*.png" If CB_FileType = "Text" Then TB_FileType = "*.txt;*.csv" If CB_FileType = "No Type" Then TB_FileType = "*[blank]" If CB_FileType = "Archives" Then TB_FileType = "*.zip;*.rar;*.arj;*.tar.gz;*.tgz;*.cpio" End Sub Private Sub CB_Send_Change() If CB_Send = "Between" Then Label_To.Visible = True Date_2.Visible = True Else Label_To.Visible = False Date_2.Visible = False End If Me.Repaint End Sub Private Sub Chk_Send_Click() If CB_Send.Text = "" Then CB_Send.ListIndex = 0 End Sub Private Sub Chk_SenderToCC_Click() If CB_SenderToCC = "" Then CB_SenderToCC.ListIndex = 0 End Sub Private Sub Chk_Subject_Click() If CB_Subject.Text = "" Then CB_Subject.ListIndex = 0 End Sub Private Sub ChkSenderToCC_Click() If CB_SenderToCC.Text = "" Then CB_SenderToCC.ListIndex = 0 End Sub Private Sub CommandButton1_Click() Dim SelItem As Integer Dim FolderName(200) As String Dim Outlook_Archive As String Dim Outlook_Path As String Dim i, j As Integer Dim Delete_Param As Integer If FileOrFolderExists(TextBox_Dir) = False Or TextBox_Dir = "" Then MsgBox ("Destination folder does not exist or not set correctly") Exit Sub End If 'Just checking that Target Folder has a \ at the end, in case path is entered manually, otherwise WriteLine & file extration will crash If Right(TextBox_Dir, 1) <> "\" Then TextBox_Dir = TextBox_Dir & "\" End If If Opt_Nothing = True Then Delete_Param = 0 End If If Opt_Del_Att.Value = True Then If MsgBox("Are you sure you want to delete the attachement, after the files are extraceted ???", vbOKCancel) = vbCancel Then Exit Sub Delete_Param = 1 End If If Opt_Del_Mail.Value = True Then If MsgBox("Are you sure you want to delete the mail, after the files are extraceted ???", vbOKCancel) = vbCancel Then Exit Sub Delete_Param = 2 End If If tvw.SelectedItem = "Outlook" Then MsgBox "Do not select Outlook" Exit Sub End If If tvw.SelectedItem.Parent.Index < 2 Then MsgBox "You must select a subfolder" Exit Sub End If If Check_Recur = True Then Att_Proc_Recur tvw, tvw.SelectedItem, TextBox_Dir, TextBox_LogFile, Delete_Param MsgBox ("Export Completed" & vbCrLf & "Destination : " & TextBox_Dir & vbCrLf & "Log file : " & TextBox_Dir & TextBox_LogFile & vbCrLf & "Recursive Mode : folders & subfolders") Else SelItem = tvw.SelectedItem.Index i = 1 While SelItem <> 1 FolderName(i) = tvw.Nodes.Item(SelItem) i = i + 1 SelItem = tvw.Nodes(SelItem).Parent.Index Wend 'Outlook root is Item (0) 'Outlook archive is supposed to be the Item -1 (1) Outlook_Archive = FolderName(i - 1) Outlook_Path = "" 'Other Folder & Subfoler are item - x (x > 1) For j = i - 2 To 1 Step -1 Outlook_Path = Outlook_Path & FolderName(j) & "/" Next Outlook_Path = Left(Outlook_Path, Len(Outlook_Path) - 1) 'remove the last "\" or it will confuse the Split function in Att_Proc 'MsgBox (Outlook_Archive & vbCrLf & Outlook_Path & vbCrLf & TextBox_Dir & vbCrLf & TextBox_LogFile & vbCrLf & Delete_Param) Att_Proc Outlook_Archive, Outlook_Path, TextBox_Dir, TextBox_LogFile, Delete_Param MsgBox ("Export Completed" & vbCrLf & "Destination : " & TextBox_Dir & vbCrLf & "Log file : " & TextBox_Dir & TextBox_LogFile) End If End Sub Private Sub Att_Proc(Outlook_Archive As String, Outlook_Path As String, Att_Path As String, Att_Log As String, Delete_Param As Integer) Dim FinalName, FileNameLegal As String Dim FinalNameCount As Integer Dim Cpt As Integer Dim i, j As Integer Dim ProgressNum, PercentNum, PercentCount As Variant Dim MyFolders, MyFolder As Variant Dim FirstFileHeader As Boolean Dim objSubject As String Dim objSenderName As String Dim objTo As String Dim objCC As String Dim objReceivedTime As Date Set objOutlook = CreateObject("Outlook.Application") Set objFolder = objOutlook.GetNamespace("MAPI").Folders(Outlook_Archive) MyFolders = Split(Outlook_Path, "/", -1, 1) For Each MyFolder In MyFolders Set objFolder = objFolder.Folders(MyFolder) Next Cpt = 0 'Incremental number of attached files Set objFSO = CreateObject("Scripting.FileSystemObject") Set objLog = objFSO.CreateTextFile(Att_Path & Att_Log) objLog.WriteLine "<HTML><TITLE>Report of Saved Attachements</TITLE><BODY><table border=""1"" cellpadding=""5"" cellspacing=""5"" width=""100%""><tr><th>Date</th><th>Outlook Archive</th><th>Outlook Folders</th></tr><tr>" objLog.WriteLine "<td>" & Now & "</td><td>" & Outlook_Archive & "</td><td>" & Outlook_Path & "</td></tr></table><br>" Set objItems = objFolder.Items If objItems.Count = 0 Then objLog.WriteLine "<br><B>I did nothing : This outlook folder is empty</B><br>" Exit Sub End If 'Set status line for those who like excel objLog.WriteLine "<table border=""1"" witdh=""100%"">" & _ "<tr>" & _ "<th>Sender</th>" & _ "<th>To</th>" & _ "<th>CC</th>" & _ "<th>Subject</th>" & _ "<th>Date</th>" & _ "<th>Attached File(s)</th>" & _ "</tr>" PercentCount = 0 'init value in case of restart ProgressBar.Min = 0 ProgressBar.Max = objItems.Count ProgressBar.Value = 0 PercentNum = 100 / objItems.Count For mailIndex = objItems.Count To 1 Step -1 'in order to get percentage, PercentCount is the progression index for each mail 'PercentLabel just add a % sign at the end ProgressBar.Value = ProgressBar.Value + 1 PercentCount = PercentCount + PercentNum PercentLabel = Int(PercentCount) & "%" 'int avoid decimal and make the percentage beautiful Set objMailItem = objItems.Item(mailIndex) On Error Resume Next 'those variables are used only to avoir any html crutial text write 'because sometime to & cc crash for meeting invitation mail objTo = "" objCC = "" objSenderName = "" objSubject = objMailItem.Subject objReceivedTime = objMailItem.ReceivedTime objSenderName = objMailItem.SenderName objTo = objMailItem.To objCC = objMailItem.CC If objMailItem.Attachments.Count > 0 And _ Subject_Match(objSubject) = True And _ Date_Match(objReceivedTime) = True And _ SenderToCC_Match(objSenderName, objTo, objCC) Then 'Write log by mail with attachement 'Properties possible '.Subject '.Attachments.Count '.UnRead '.SenderName '.ReceivedTime '.LastModificationTime '.ReplyRecipientNames '.SentOn '.Body On Error Resume Next FirstFileHeader = True For i = 1 To objMailItem.Attachments.Count Set pj = objMailItem.Attachments.Item(i) If FileSize_Match(pj.Size) = True _ And FileType_Match(pj.DisplayName) = True _ And FileName_Match(pj.DisplayName) = True Then FinalNameCount = 0 FileNameLegal = LegalizeFileName(pj.DisplayName) 'removing unwanted chars, usefull for email attached FinalName = FileNameLegal While FileOrFolderExists(Att_Path & FinalName) = True 'if file already exist, a number will be implemente between filename & extenstion like filname(23).txt FinalNameCount = FinalNameCount + 1 'FinalNameCount is the index used to get unique name FinalName = FileNumbering(FileNameLegal, FinalNameCount) 'this function implement the number between filename & extenstion Wend pj.SaveAsFile Att_Path & FinalName 'Save the attached files Set pj = Nothing If FirstFileHeader = True Then objLog.WriteLine "<tr>" & _ "<td>" & objMailItem.SenderName & " </td>" & _ "<td>" & Replace(objTo, ";", "<br>") & " </td>" & _ "<td>" & Replace(objCC, ";", "<br>") & " </td>" & _ "<td>" & objSubject & " </td>" & _ "<td>" & objMailItem.ReceivedTime & "</td>" & _ "<td>" 'Start of file attached HTML part FirstFileHeader = False End If objLog.WriteLine "<a target=""_blank"" href=""" & FinalName & """>" & FinalName & "</a><br>" ' Middle of file attached HTML part Cpt = Cpt + 1 End If Next objLog.WriteLine "</td></tr>" 'End of file attached HTML part If Delete_Param = 0 Then 'do nothing ! Mouhahahahaha End If If Delete_Param = 1 Then While objMailItem.Attachments.Count > 0 'as the count decrement everytime a file is deleted, cannot use for, but use item(1), and repeat while count > 0 objMailItem.Attachments.Item(1).Delete 'delete the attached files Wend objMailItem.Save 'need to save the mail to apply the file(s) deletion End If If Delete_Param = 2 Then objMailItem.Delete 'The mail is delete. I kept this function as it was in the initial macro, but it's dangerous. There is two a warns about it End If If Not Err.Number = 0 Then objLog.WriteLine "<a target=""_blank"" href=""" & FinalName & """>" & FinalName & "</a> #ERROR<br>" ' Middle of file attached HTML part End If End If Next PercentLabel = "100%" 'force the 100%, otherwise, it ends at int(99.99999999999999999999) so 99% : that's not serious objLog.WriteLine "</tr></table><br><i>" & Cpt & " attachment(s) treated</i></BODY></HTML>" End Sub Private Sub Att_Proc_Recur(ByRef tv As TreeView, ByRef nodThis As Node, DestinationDir As String, LogFileName As String, Delete_Param As Integer) Dim lngIndex As Long Dim FolderName(200) As String Dim Outlook_Archive As String Dim Outlook_Path As String Dim Real_Path As String If nodThis.Children > 0 Then lngIndex = nodThis.Child.Index Call Att_Proc_Recur(tv, tv.Nodes(lngIndex), DestinationDir, LogFileName, Delete_Param) While lngIndex <> nodThis.Child.LastSibling.Index lngIndex = tv.Nodes(lngIndex).Next.Index Call Att_Proc_Recur(tv, tv.Nodes(lngIndex), DestinationDir, LogFileName, Delete_Param) Wend End If SelItem = nodThis.Index i = 1 While SelItem <> 1 FolderName(i) = tvw.Nodes.Item(SelItem) i = i + 1 SelItem = tvw.Nodes(SelItem).Parent.Index Wend 'Outlook root is Item (0) 'Outlook archive is supposed to be the Item -1 (1) Outlook_Archive = FolderName(i - 1) Outlook_Path = "" 'Other Folder & Subfoler are item - x (x > 1) For j = i - 2 To 1 Step -1 Outlook_Path = Outlook_Path & FolderName(j) & "/" Next Outlook_Path = Left(Outlook_Path, Len(Outlook_Path) - 1) 'remove the last "\" or it will confuse the Split function in Att_Proc Real_Path = Replace(Outlook_Path, "/", "\") & "\" 'cheating... will pay for it one day CreateSubDirectories (DestinationDir & LegalizeFolderName(Real_Path)) Att_Proc Outlook_Archive, Outlook_Path, DestinationDir & LegalizeFolderName(Real_Path), LogFileName, Delete_Param 'MsgBox (nodThis.Index) End Sub Private Function FileNumbering(NomFichier As String, NumFichier As Integer) As String Dim DotPos As Integer If InStr(1, NomFichier, ".") = 0 Then 'if not "." exist, it means, not extension FileNumbering = NomFichier & "(" & NumFichier & ")" Else While Left(Right(NomFichier, DotPos), 1) <> "." 'find the first "." from the right, which is supposed to be the start of the extension DotPos = DotPos + 1 Wend FileNumbering = Left(NomFichier, Len(NomFichier) - DotPos) & "(" & NumFichier & ")." & Right(NomFichier, DotPos - 1) End If End Function Private Sub Opt_Del_Att_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If Opt_Del_Att = True Then If MsgBox("Are you sure you want to delete the attachement, after the files are extraceted ???", vbOKCancel, "WARNING") = vbCancel Then Opt_Del_Att = False Opt_Nothing = True Cancel = True End If End If End Sub Private Sub Opt_Del_Mail_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If Opt_Del_Mail = True Then If MsgBox("Are you sure you want to delete the mail, after the files are extraceted ???", vbOKCancel, "WARNING") = vbCancel Then Opt_Del_Mail = False Opt_Nothing = True Cancel = True End If End If End Sub Private Sub UserForm_Initialize() PercentLabel = "" Dim olApp As Outlook.Application Dim olNameSpace Dim olFolder As Outlook.MAPIFolder Dim tvNode As MSComctlLib.Node Dim tvRoot As MSComctlLib.Node Set olApp = GetObject(, "Outlook.Application") Set tvRoot = tvw.Nodes.Add(Text:="Outlook") Set olNameSpace = olApp.GetNamespace("MAPI") GetSubFolders olNameSpace, tvRoot Set tvNode = Nothing Set olFolder = Nothing Set olNameSpace = Nothing Set tvRoot = Nothing Set olApp = Nothing 'Addint Combo box criteria CB_Subject.AddItem "Contains" CB_Subject.AddItem "Is" CB_Subject.AddItem "Is not" CB_Subject.ListIndex = 0 CB_Send.AddItem "After" CB_Send.AddItem "Before" CB_Send.AddItem "Between" CB_Send.AddItem "This day" CB_Send.ListIndex = 0 CB_SenderToCC.AddItem "Contains" CB_SenderToCC.AddItem "Is" CB_SenderToCC.AddItem "Is not" CB_SenderToCC.ListIndex = 0 Opt_Kb.Value = True CB_FileSize.AddItem "Bigger Than" CB_FileSize.AddItem "Smaller Than" CB_FileSize.ListIndex = 0 CB_FileType.AddItem "Office docs" CB_FileType.AddItem "Excel" CB_FileType.AddItem "Word" CB_FileType.AddItem "PowerPoint" CB_FileType.AddItem "PDF" CB_FileType.AddItem "Pictures" CB_FileType.AddItem "Text" CB_FileType.AddItem "Archives" CB_FileType.AddItem "No Type" CB_FileType.ListIndex = 0 CB_FileName.AddItem "Contains" CB_FileName.AddItem "Is" CB_FileName.ListIndex = 0 End Sub Private Function FileType_Match(NomFichier As String) As Boolean Dim DotPos As Integer Dim myType As String Dim formType, thisType As Variant If Chk_FileType = False Then FileType_Match = True Exit Function End If FileType_Match = False If InStr(1, NomFichier, ".") = 0 Then 'if not "." exist, it means, not extension If InStr(1, TB_FileType, "*[blank]") > 0 Then FileType_Match = True Else FileType_Match = False End If Exit Function Else While Left(Right(NomFichier, DotPos), 1) <> "." 'find the first "." from the right, which is supposed to be the start of the extension DotPos = DotPos + 1 Wend myType = Right(NomFichier, DotPos - 1) End If formType = Split(TB_FileType, ";") For Each thisType In formType If InStr(1, thisType, myType) > 0 Then FileType_Match = True End If Next End Function Function FileSize_Match(myFileSize As Long) As Boolean Dim byteSize As Long If Chk_FileSize = False Or TB_FileSize = "" Then FileSize_Match = True Exit Function End If If Opt_Kb = True Then byteSize = Int(TB_FileSize) * 1024 Else byteSize = Int(TB_FileSize) * 1024 * 1024 End If FileSize_Match = False If CB_FileSize = "Bigger Than" Then If myFileSize >= byteSize Then FileSize_Match = True ElseIf cbfilesize = "Smaller Than" Then If myFileSize <= byteSize Then FileSize_Match = True End If End Function Function FileName_Match(myAttachement As String) As Boolean If Chk_FileName = False Then FileName_Match = True Exit Function End If FileName_Match = False If CB_FileName = "Is" And UCase(TB_FileName) = UCase(myAttachement) Then FileName_Match = True ElseIf CB_FileName = "Contains" And InStr(1, UCase(myAttachement), UCase(TB_FileName)) > 0 Then FileName_Match = True End If End Function Function Subject_Match(Mail_Subject As String) As Boolean If Chk_Subject = False Then Subject_Match = True Exit Function End If Subject_Match = False If CB_Subject = "Is" And UCase(TB_Subject) = UCase(Mail_Subject) Then Subject_Match = True ElseIf CB_Subject = "Is not" And UCase(TB_Subject) <> UCase(Mail_Subject) Then Subject_Match = True ElseIf CB_Subject = "Contains" And InStr(1, UCase(Mail_Subject), UCase(TB_Subject)) > 0 Then Subject_Match = True End If End Function Function SenderToCC_Match(Sender_Mail As String, To_Mail As String, CC_Mail As String) As Boolean If Chk_SenderToCC = False Then SenderToCC_Match = True Exit Function End If SenderToCC_Match = False If CB_SenderToCC = "Is" And (UCase(TB_SenderToCC) = UCase(Sender_Mail) _ Or UCase(TB_SenderToCC) = UCase(To_Mail) _ Or UCase(TB_SenderToCC) = UCase(CC_Mail)) Then SenderToCC_Match = True ElseIf CB_SenderToCC = "Is not" And (InStr(1, UCase(Sender_Mail), UCase(TB_SenderToCC)) = 0 _ And InStr(1, UCase(To_Mail), UCase(TB_SenderToCC)) = 0 _ And InStr(1, UCase(CC_Mail), UCase(TB_SenderToCC)) = 0) Then SenderToCC_Match = True ElseIf CB_SenderToCC = "Contains" And (InStr(1, UCase(Sender_Mail), UCase(TB_SenderToCC)) > 0 _ Or InStr(1, UCase(To_Mail), UCase(TB_SenderToCC)) > 0 _ Or InStr(1, UCase(CC_Mail), UCase(TB_SenderToCC)) > 0) Then SenderToCC_Match = True End If End Function Function Date_Match(Mail_Date As Date) As Boolean If Chk_Send = False Then Date_Match = True Exit Function End If Date_Match = False If CB_Send = "Before" And Mail_Date <= Date_1 Then Date_Match = True ElseIf CB_Send = "After" And Mail_Date >= Date_1 Then Date_Match = True ElseIf CB_Send = "Between" And Mail_Date >= Date_1 And Mail_Date <= Date_2 Then Date_Match = True ElseIf CB_Send = "This day" And Mail_Date = Date_1 Then Date_Match = True End If End Function Private Sub GetSubFolders(olFolder, tvNode As MSComctlLib.Node) Dim tvChild As MSComctlLib.Node Dim olSubFolder As Outlook.MAPIFolder For Each olSubFolder In olFolder.Folders Set tvChild = tvw.Nodes.Add(Text:=olSubFolder.Name, _ Relative:=tvNode, Relationship:=tvwChild) GetSubFolders olSubFolder, tvChild Next olSubFolder Set olSubFolder = Nothing Set tvChild = Nothing End Sub Function BrowseForFolder(Optional OpenAt As Variant) As Variant Dim ShellApp As Object Set ShellApp = CreateObject("Shell.Application"). _ BrowseForFolder(0, "Please choose a folder", 0, OpenAt) On Error Resume Next BrowseForFolder = ShellApp.self.Path On Error GoTo 0 Set ShellApp = Nothing Select Case Mid(BrowseForFolder, 2, 1) Case Is = ":" 'My macro will never work on a MAC, but how cares If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid Case Is = "\" If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid Case Else GoTo Invalid End Select Exit Function Invalid: BrowseForFolder = False 'shit happens End Function Function LegalizeFileName(FileName As String) As String 'This function remove all windows files unwanted chars 'Feel free to add any windows files forbidden characteres FileName = Replace(FileName, "\", "") FileName = Replace(FileName, "/", "") FileName = Replace(FileName, ":", "") FileName = Replace(FileName, "?", "") FileName = Replace(FileName, """", "") FileName = Replace(FileName, "<", "") FileName = Replace(FileName, ">", "") FileName = Replace(FileName, "|", "") LegalizeFileName = FileName End Function Function LegalizeFolderName(FileName As String) As String 'This function remove all windows files unwanted chars 'Feel free to add any windows files forbidden characteres 'FileName = Replace(FileName, "\", "") --> for sure we need to keep the \ for the folders FileName = Replace(FileName, "/", "") FileName = Replace(FileName, ":", "") FileName = Replace(FileName, "?", "") FileName = Replace(FileName, """", "") FileName = Replace(FileName, "<", "") FileName = Replace(FileName, ">", "") FileName = Replace(FileName, "|", "") LegalizeFolderName = FileName End Function Sub CreateSubDirectories(fullPath As String) Dim str As String Dim strArray As Variant Dim i As Long Dim basePath As String Dim newPath As String str = fullPath ' add trailing slash If Right$(str, 1) <> "\" Then str = str & "\" End If ' split string into array strArray = Split(str, "\") basePath = strArray(0) & "\" ' loop through array and create progressively ' lower level folders For i = 1 To UBound(strArray) - 1 If Len(newPath) = 0 Then newPath = basePath & newPath & strArray(i) & "\" Else newPath = newPath & strArray(i) & "\" End If If Not FileOrFolderExists(newPath) Then MkDir newPath End If Next i End Sub
15 oct. 2012 à 08:15
Simple question : cela peut-il marcher aussi avec Outlook 2003 ?
Merci et en tout cas bravo pour ce partage de savoir faire.
16 févr. 2012 à 18:52
Personnellement j'utilise les dossiers publics et personels, je n'ai donc pas enlevé ces dossiers.
Il est a noter que ce programme ne fonctionne pas hors-ligne, peut-être à cause de cela. Je n'ai pas encore creusé la question. (j'utilise Outlook 2010).
Si certains voulaient qu'il puisse fonctionner hors ligne, merci de m'envoyer vos commentaires !
16 févr. 2012 à 11:19
ce programme est très utile.
je commence les tests, il a fallu que j'adapte la procédure pour filtrer le chargement et ne pas charger dans la treeview les "Dossiers personnels" et les "Dossiers publics" j'ai ajouté dans la fonction GetSubFolders un paramétre afin de ne pas descendre les dites arborescences. J'ai constaté le bon export des documents joints. Merci mille fois
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.