Je viens de me rendre compte que dans le fichier .pst que j'utilise en
ce moment j'avais perdu une bonne partie de mes archives.
A partir d'un ancien fichier .pst sauvegardé, je souhaiterais pouvoir
récupérer sous Excel les RdV manquants pour ensuite les réexporter dans
le bon fichier .pst
J'ai trouvé sur le site Outlook.com des bouts de code que j'ai essayé
d'assembler et d'adapter à xls, mais cela coince dans la récupération
des données de périodicité.
Le message d'erreur est : Incompatibilité de type.
L'un d'entre vous pourrait-il m'aider à résoudre ce problème.
Avec mes remerciements anticipés,
Cordialement
Philippe
Option Explicit
Sub SaveCalendarToExcel()
'Created by Helen Feddema 9-17-2004
'Last modified 9-17-2004
'Demonstrates pushing Calendar data to rows in an Excel worksheet
'adpaté à xls, modifié et complété le 11-09-2005
'On Error GoTo ErrorHandler
Dim appOlk As Outlook.Application
Dim appWord As Word.Application
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim strTemplatePath As String
Dim i As Integer
Dim j As Integer
Dim lngCount As Long
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
'Must declare as Object because folders may contain different
'types of items
Dim itm As Object
Dim strTitle As String
Dim strPrompt As String
Dim aptPtrn As Outlook.RecurrencePattern
'Pick up Template path from the Word Options dialog
Set appWord = GetObject(, "Word.Application")
'strTemplatePath =
appWord.Options.DefaultFilePath(wdUserTemplatesPath) & "\"
strTemplatePath = "c:\Mes Documents\Documents Excel\"
Debug.Print "Templates folder: " & strTemplatePath
strSheet = "Calendar.xls"
strSheet = strTemplatePath & strSheet
Debug.Print "Excel workbook: " & strSheet
'Test for file in the Templates folder
If TestFileExists(strSheet) = False Then
strTitle = "Worksheet file not found"
strPrompt = strSheet & _
" not found; please copy Calendar.xls to this
folder and try again"
MsgBox strPrompt, vbCritical + vbOKOnly, strTitle
GoTo ErrorHandlerExit
End If
Set appExcel = GetObject(, "Excel.Application")
' appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets("Import")
wks.Activate
appExcel.Application.Visible = True
'Let user select a folder to export
Set appOlk = CreateObject("Outlook.Application")
Set nms = appOlk.GetNamespace("MAPI")
Set fld = nms.PickFolder
If fld Is Nothing Then
GoTo ErrorHandlerExit
End If
'Test whether selected folder contains contact items
If fld.DefaultItemType <> olAppointmentItem Then
MsgBox "Folder is not a calendar folder"
GoTo ErrorHandlerExit
End If
lngCount = fld.Items.Count
If lngCount = 0 Then
MsgBox "No appointments to export"
GoTo ErrorHandlerExit
Else
Debug.Print lngCount & " appointments to export"
End If
'Adjust i (row number) to be 1 less than the number of the first
body row
i = 4
'Iterate through contact items in Calendar folder, and export a few
fields
'from each item to a row in the Calendar worksheet
For Each itm In fld.Items
If itm.Class = olAppointment Then
'Process item only if it is an appointment item
' i = i + 1
'j is the column number
j = 2
Set rng = wks.Cells(i, j)
If itm.Start <> "" Then rng.Value = itm.Start
j = j + 1
Set rng = wks.Cells(i, j) 'col3
If itm.End <> "" Then rng.Value = itm.End
j = j + 1
'C'est là que çà coince (Incompatibilité de type) !!!!!!!
Set aptPtrn = itm.GetRecurrencePattern
Set rng = wks.Cells(i, j) 'col4
If aptPtrn.StartTime <> "" Then
rng.Value = aptPtrn.StartTime
j = j + 1
Set rng = wks.Cells(i, j) 'col5
If aptPtrn.EndTime <> "" Then
rng.Value = aptPtrn.EndTime
j = j + 1
Set rng = wks.Cells(i, j) 'col6
If aptPtrn.RecurrenceType <> "" Then
rng.Value = aptPtrn.RecurrenceType
j = j + 1
Set rng = wks.Cells(i, j) 'col7
If aptPtrn.NoEndDate <> "" Then rng.Value = aptPtrn.NoEndDate
j = j + 1
Set rng = wks.Cells(i, j) 'col8
If itm.Duration <> "" Then rng.Value = itm.Duration
j = j + 1
Set rng = wks.Cells(i, j) 'col9
If itm.CreationTime <> "" Then rng.Value = itm.CreationTime
j = j + 1
Set rng = wks.Cells(i, j) 'col10
If itm.Subject <> "" Then rng.Value = itm.Subject
j = j + 1
Set rng = wks.Cells(i, j) 'col11
If itm.Location <> "" Then rng.Value = itm.Location
j = j + 1
Set rng = wks.Cells(i, j) 'col12
If itm.Categories <> "" Then rng.Value = itm.Categories
j = j + 1
Set rng = wks.Cells(i, j) 'col13
If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
j = j + 1
Set rng = wks.Cells(i, j) 'col14
On Error Resume Next
'The next line illustrates the syntax for referencing
'a custom Outlook field
If itm.UserProperties("CustomField") <> "" Then
rng.Value = itm.UserProperties("CustomField")
End If
j = j + 1
Set rng = wks.Cells(i, j) 'col15
rng.FormulaR1C1Local = "=NB.SI(L3C14:LC14,LC14)"
End If
i = i + 1
Next itm
ErrorHandlerExit:
Exit Sub
ErrorHandler:
If Err.Number = 429 Then
'Application object is not set by GetObject; use CreateObject
instead
If appWord Is Nothing Then
Set appWord = CreateObject("Word.Application")
Resume Next
ElseIf appExcel Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Resume Next
End If
Else
MsgBox "Error No: " & Err.Number & "; Description: "
Resume ErrorHandlerExit
End If
End Sub
Public Function TestFileExists(strFile As String) As Boolean
'Created by Helen Feddema 9-1-2004
'Last modified 9-1-2004
'Tests for existing of a file, using the FileSystemObject
Dim fso As New Scripting.FileSystemObject
Dim fil As Scripting.File
On Error Resume Next
Set fil = fso.GetFile(strFile)
If fil Is Nothing Then
TestFileExists = False
Else
TestFileExists = True
End If
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
Circé
Bonjour Philippe,
Ta procédure me paraît bien compliquée !! Pourquoi passer par Excel ?.. Pourquoi faut-il une macro ?... Pourquoi faire simple quand on peut faire compliqué ?... ;D
Il suffit que tu importes dans ton pst en cours ton fichier pst sauvegaqrdé en refusant les doublons. C'est aussi bête que ça ou alors j'ai rien compris à ton problème !
Menu Fichier, Importer et exporter Importer depuis un autre programme ou fichier Fichier de données personnel (pst) Ne pas importer les doublons OUvrir le dossier et choisir Calendrier
C'est tout.
Circé http://faqword.free.fr
Il se trouve que Philippe a formulé :
Bonjour à tous,
Je viens de me rendre compte que dans le fichier .pst que j'utilise en ce moment j'avais perdu une bonne partie de mes archives. A partir d'un ancien fichier .pst sauvegardé, je souhaiterais pouvoir récupérer sous Excel les RdV manquants pour ensuite les réexporter dans le bon fichier .pst
J'ai trouvé sur le site Outlook.com des bouts de code que j'ai essayé d'assembler et d'adapter à xls, mais cela coince dans la récupération des données de périodicité.
Le message d'erreur est : Incompatibilité de type.
L'un d'entre vous pourrait-il m'aider à résoudre ce problème.
Avec mes remerciements anticipés,
Cordialement
Philippe
Option Explicit
Sub SaveCalendarToExcel() 'Created by Helen Feddema 9-17-2004 'Last modified 9-17-2004 'Demonstrates pushing Calendar data to rows in an Excel worksheet 'adpaté à xls, modifié et complété le 11-09-2005
'On Error GoTo ErrorHandler
Dim appOlk As Outlook.Application
Dim appWord As Word.Application Dim appExcel As Excel.Application Dim wkb As Excel.Workbook Dim wks As Excel.Worksheet Dim rng As Excel.Range Dim strSheet As String Dim strTemplatePath As String Dim i As Integer Dim j As Integer Dim lngCount As Long Dim nms As Outlook.NameSpace Dim fld As Outlook.MAPIFolder 'Must declare as Object because folders may contain different 'types of items Dim itm As Object Dim strTitle As String Dim strPrompt As String Dim aptPtrn As Outlook.RecurrencePattern
'Pick up Template path from the Word Options dialog Set appWord = GetObject(, "Word.Application") 'strTemplatePath > appWord.Options.DefaultFilePath(wdUserTemplatesPath) & "" strTemplatePath = "c:Mes DocumentsDocuments Excel" Debug.Print "Templates folder: " & strTemplatePath strSheet = "Calendar.xls" strSheet = strTemplatePath & strSheet Debug.Print "Excel workbook: " & strSheet
'Test for file in the Templates folder If TestFileExists(strSheet) = False Then strTitle = "Worksheet file not found" strPrompt = strSheet & _ " not found; please copy Calendar.xls to this folder and try again" MsgBox strPrompt, vbCritical + vbOKOnly, strTitle GoTo ErrorHandlerExit End If
Set appExcel = GetObject(, "Excel.Application") ' appExcel.Workbooks.Open (strSheet) Set wkb = appExcel.ActiveWorkbook Set wks = wkb.Sheets("Import") wks.Activate appExcel.Application.Visible = True
'Let user select a folder to export Set appOlk = CreateObject("Outlook.Application") Set nms = appOlk.GetNamespace("MAPI") Set fld = nms.PickFolder If fld Is Nothing Then GoTo ErrorHandlerExit End If
'Test whether selected folder contains contact items If fld.DefaultItemType <> olAppointmentItem Then MsgBox "Folder is not a calendar folder" GoTo ErrorHandlerExit End If
lngCount = fld.Items.Count
If lngCount = 0 Then MsgBox "No appointments to export" GoTo ErrorHandlerExit Else Debug.Print lngCount & " appointments to export" End If
'Adjust i (row number) to be 1 less than the number of the first body row i = 4
'Iterate through contact items in Calendar folder, and export a few fields 'from each item to a row in the Calendar worksheet For Each itm In fld.Items If itm.Class = olAppointment Then 'Process item only if it is an appointment item ' i = i + 1
'j is the column number j = 2
Set rng = wks.Cells(i, j) If itm.Start <> "" Then rng.Value = itm.Start j = j + 1
Set rng = wks.Cells(i, j) 'col3 If itm.End <> "" Then rng.Value = itm.End j = j + 1
'C'est là que çà coince (Incompatibilité de type) !!!!!!! Set aptPtrn = itm.GetRecurrencePattern
Set rng = wks.Cells(i, j) 'col4 If aptPtrn.StartTime <> "" Then rng.Value = aptPtrn.StartTime j = j + 1
Set rng = wks.Cells(i, j) 'col5 If aptPtrn.EndTime <> "" Then rng.Value = aptPtrn.EndTime j = j + 1
Set rng = wks.Cells(i, j) 'col6 If aptPtrn.RecurrenceType <> "" Then rng.Value = aptPtrn.RecurrenceType j = j + 1
Set rng = wks.Cells(i, j) 'col7 If aptPtrn.NoEndDate <> "" Then rng.Value = aptPtrn.NoEndDate j = j + 1
Set rng = wks.Cells(i, j) 'col8 If itm.Duration <> "" Then rng.Value = itm.Duration j = j + 1
Set rng = wks.Cells(i, j) 'col9 If itm.CreationTime <> "" Then rng.Value = itm.CreationTime j = j + 1
Set rng = wks.Cells(i, j) 'col10 If itm.Subject <> "" Then rng.Value = itm.Subject j = j + 1
Set rng = wks.Cells(i, j) 'col11 If itm.Location <> "" Then rng.Value = itm.Location j = j + 1
Set rng = wks.Cells(i, j) 'col12 If itm.Categories <> "" Then rng.Value = itm.Categories j = j + 1
Set rng = wks.Cells(i, j) 'col13 If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring j = j + 1
Set rng = wks.Cells(i, j) 'col14 On Error Resume Next 'The next line illustrates the syntax for referencing 'a custom Outlook field If itm.UserProperties("CustomField") <> "" Then rng.Value = itm.UserProperties("CustomField") End If j = j + 1
Set rng = wks.Cells(i, j) 'col15 rng.FormulaR1C1Local = "=NB.SI(L3C14:LC14,LC14)" End If i = i + 1 Next itm
ErrorHandlerExit: Exit Sub
ErrorHandler: If Err.Number = 429 Then 'Application object is not set by GetObject; use CreateObject instead If appWord Is Nothing Then Set appWord = CreateObject("Word.Application") Resume Next ElseIf appExcel Is Nothing Then Set appExcel = CreateObject("Excel.Application") Resume Next End If Else MsgBox "Error No: " & Err.Number & "; Description: " Resume ErrorHandlerExit End If
End Sub
Public Function TestFileExists(strFile As String) As Boolean 'Created by Helen Feddema 9-1-2004 'Last modified 9-1-2004 'Tests for existing of a file, using the FileSystemObject
Dim fso As New Scripting.FileSystemObject Dim fil As Scripting.File
On Error Resume Next
Set fil = fso.GetFile(strFile) If fil Is Nothing Then TestFileExists = False Else TestFileExists = True End If
End Function
Bonjour Philippe,
Ta procédure me paraît bien compliquée !!
Pourquoi passer par Excel ?.. Pourquoi faut-il une macro ?...
Pourquoi faire simple quand on peut faire compliqué ?... ;D
Il suffit que tu importes dans ton pst en cours ton fichier pst
sauvegaqrdé en refusant les doublons. C'est aussi bête que ça ou alors
j'ai rien compris à ton problème !
Menu Fichier, Importer et exporter
Importer depuis un autre programme ou fichier
Fichier de données personnel (pst)
Ne pas importer les doublons
OUvrir le dossier et choisir Calendrier
C'est tout.
Circé
http://faqword.free.fr
Il se trouve que Philippe a formulé :
Bonjour à tous,
Je viens de me rendre compte que dans le fichier .pst que j'utilise
en
ce moment j'avais perdu une bonne partie de mes archives.
A partir d'un ancien fichier .pst sauvegardé, je souhaiterais pouvoir
récupérer sous Excel les RdV manquants pour ensuite les réexporter
dans
le bon fichier .pst
J'ai trouvé sur le site Outlook.com des bouts de code que j'ai essayé
d'assembler et d'adapter à xls, mais cela coince dans la récupération
des données de périodicité.
Le message d'erreur est : Incompatibilité de type.
L'un d'entre vous pourrait-il m'aider à résoudre ce problème.
Avec mes remerciements anticipés,
Cordialement
Philippe
Option Explicit
Sub SaveCalendarToExcel()
'Created by Helen Feddema 9-17-2004
'Last modified 9-17-2004
'Demonstrates pushing Calendar data to rows in an Excel worksheet
'adpaté à xls, modifié et complété le 11-09-2005
'On Error GoTo ErrorHandler
Dim appOlk As Outlook.Application
Dim appWord As Word.Application
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim strTemplatePath As String
Dim i As Integer
Dim j As Integer
Dim lngCount As Long
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
'Must declare as Object because folders may contain different
'types of items
Dim itm As Object
Dim strTitle As String
Dim strPrompt As String
Dim aptPtrn As Outlook.RecurrencePattern
'Pick up Template path from the Word Options dialog
Set appWord = GetObject(, "Word.Application")
'strTemplatePath > appWord.Options.DefaultFilePath(wdUserTemplatesPath) & ""
strTemplatePath = "c:Mes DocumentsDocuments Excel"
Debug.Print "Templates folder: " & strTemplatePath
strSheet = "Calendar.xls"
strSheet = strTemplatePath & strSheet
Debug.Print "Excel workbook: " & strSheet
'Test for file in the Templates folder
If TestFileExists(strSheet) = False Then
strTitle = "Worksheet file not found"
strPrompt = strSheet & _
" not found; please copy Calendar.xls to this
folder and try again"
MsgBox strPrompt, vbCritical + vbOKOnly, strTitle
GoTo ErrorHandlerExit
End If
Set appExcel = GetObject(, "Excel.Application")
' appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets("Import")
wks.Activate
appExcel.Application.Visible = True
'Let user select a folder to export
Set appOlk = CreateObject("Outlook.Application")
Set nms = appOlk.GetNamespace("MAPI")
Set fld = nms.PickFolder
If fld Is Nothing Then
GoTo ErrorHandlerExit
End If
'Test whether selected folder contains contact items
If fld.DefaultItemType <> olAppointmentItem Then
MsgBox "Folder is not a calendar folder"
GoTo ErrorHandlerExit
End If
lngCount = fld.Items.Count
If lngCount = 0 Then
MsgBox "No appointments to export"
GoTo ErrorHandlerExit
Else
Debug.Print lngCount & " appointments to export"
End If
'Adjust i (row number) to be 1 less than the number of the first
body row
i = 4
'Iterate through contact items in Calendar folder, and export a
few
fields
'from each item to a row in the Calendar worksheet
For Each itm In fld.Items
If itm.Class = olAppointment Then
'Process item only if it is an appointment item
' i = i + 1
'j is the column number
j = 2
Set rng = wks.Cells(i, j)
If itm.Start <> "" Then rng.Value = itm.Start
j = j + 1
Set rng = wks.Cells(i, j) 'col3
If itm.End <> "" Then rng.Value = itm.End
j = j + 1
'C'est là que çà coince (Incompatibilité de type)
!!!!!!!
Set aptPtrn = itm.GetRecurrencePattern
Set rng = wks.Cells(i, j) 'col4
If aptPtrn.StartTime <> "" Then
rng.Value = aptPtrn.StartTime
j = j + 1
Set rng = wks.Cells(i, j) 'col5
If aptPtrn.EndTime <> "" Then
rng.Value = aptPtrn.EndTime
j = j + 1
Set rng = wks.Cells(i, j) 'col6
If aptPtrn.RecurrenceType <> "" Then
rng.Value = aptPtrn.RecurrenceType
j = j + 1
Set rng = wks.Cells(i, j) 'col7
If aptPtrn.NoEndDate <> "" Then rng.Value =
aptPtrn.NoEndDate
j = j + 1
Set rng = wks.Cells(i, j) 'col8
If itm.Duration <> "" Then rng.Value = itm.Duration
j = j + 1
Set rng = wks.Cells(i, j) 'col9
If itm.CreationTime <> "" Then rng.Value =
itm.CreationTime
j = j + 1
Set rng = wks.Cells(i, j) 'col10
If itm.Subject <> "" Then rng.Value = itm.Subject
j = j + 1
Set rng = wks.Cells(i, j) 'col11
If itm.Location <> "" Then rng.Value = itm.Location
j = j + 1
Set rng = wks.Cells(i, j) 'col12
If itm.Categories <> "" Then rng.Value = itm.Categories
j = j + 1
Set rng = wks.Cells(i, j) 'col13
If itm.IsRecurring <> "" Then rng.Value =
itm.IsRecurring
j = j + 1
Set rng = wks.Cells(i, j) 'col14
On Error Resume Next
'The next line illustrates the syntax for referencing
'a custom Outlook field
If itm.UserProperties("CustomField") <> "" Then
rng.Value = itm.UserProperties("CustomField")
End If
j = j + 1
Set rng = wks.Cells(i, j) 'col15
rng.FormulaR1C1Local = "=NB.SI(L3C14:LC14,LC14)"
End If
i = i + 1
Next itm
ErrorHandlerExit:
Exit Sub
ErrorHandler:
If Err.Number = 429 Then
'Application object is not set by GetObject; use
CreateObject
instead
If appWord Is Nothing Then
Set appWord = CreateObject("Word.Application")
Resume Next
ElseIf appExcel Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Resume Next
End If
Else
MsgBox "Error No: " & Err.Number & "; Description: "
Resume ErrorHandlerExit
End If
End Sub
Public Function TestFileExists(strFile As String) As Boolean
'Created by Helen Feddema 9-1-2004
'Last modified 9-1-2004
'Tests for existing of a file, using the FileSystemObject
Dim fso As New Scripting.FileSystemObject
Dim fil As Scripting.File
On Error Resume Next
Set fil = fso.GetFile(strFile)
If fil Is Nothing Then
TestFileExists = False
Else
TestFileExists = True
End If
Ta procédure me paraît bien compliquée !! Pourquoi passer par Excel ?.. Pourquoi faut-il une macro ?... Pourquoi faire simple quand on peut faire compliqué ?... ;D
Il suffit que tu importes dans ton pst en cours ton fichier pst sauvegaqrdé en refusant les doublons. C'est aussi bête que ça ou alors j'ai rien compris à ton problème !
Menu Fichier, Importer et exporter Importer depuis un autre programme ou fichier Fichier de données personnel (pst) Ne pas importer les doublons OUvrir le dossier et choisir Calendrier
C'est tout.
Circé http://faqword.free.fr
Il se trouve que Philippe a formulé :
Bonjour à tous,
Je viens de me rendre compte que dans le fichier .pst que j'utilise en ce moment j'avais perdu une bonne partie de mes archives. A partir d'un ancien fichier .pst sauvegardé, je souhaiterais pouvoir récupérer sous Excel les RdV manquants pour ensuite les réexporter dans le bon fichier .pst
J'ai trouvé sur le site Outlook.com des bouts de code que j'ai essayé d'assembler et d'adapter à xls, mais cela coince dans la récupération des données de périodicité.
Le message d'erreur est : Incompatibilité de type.
L'un d'entre vous pourrait-il m'aider à résoudre ce problème.
Avec mes remerciements anticipés,
Cordialement
Philippe
Option Explicit
Sub SaveCalendarToExcel() 'Created by Helen Feddema 9-17-2004 'Last modified 9-17-2004 'Demonstrates pushing Calendar data to rows in an Excel worksheet 'adpaté à xls, modifié et complété le 11-09-2005
'On Error GoTo ErrorHandler
Dim appOlk As Outlook.Application
Dim appWord As Word.Application Dim appExcel As Excel.Application Dim wkb As Excel.Workbook Dim wks As Excel.Worksheet Dim rng As Excel.Range Dim strSheet As String Dim strTemplatePath As String Dim i As Integer Dim j As Integer Dim lngCount As Long Dim nms As Outlook.NameSpace Dim fld As Outlook.MAPIFolder 'Must declare as Object because folders may contain different 'types of items Dim itm As Object Dim strTitle As String Dim strPrompt As String Dim aptPtrn As Outlook.RecurrencePattern
'Pick up Template path from the Word Options dialog Set appWord = GetObject(, "Word.Application") 'strTemplatePath > appWord.Options.DefaultFilePath(wdUserTemplatesPath) & "" strTemplatePath = "c:Mes DocumentsDocuments Excel" Debug.Print "Templates folder: " & strTemplatePath strSheet = "Calendar.xls" strSheet = strTemplatePath & strSheet Debug.Print "Excel workbook: " & strSheet
'Test for file in the Templates folder If TestFileExists(strSheet) = False Then strTitle = "Worksheet file not found" strPrompt = strSheet & _ " not found; please copy Calendar.xls to this folder and try again" MsgBox strPrompt, vbCritical + vbOKOnly, strTitle GoTo ErrorHandlerExit End If
Set appExcel = GetObject(, "Excel.Application") ' appExcel.Workbooks.Open (strSheet) Set wkb = appExcel.ActiveWorkbook Set wks = wkb.Sheets("Import") wks.Activate appExcel.Application.Visible = True
'Let user select a folder to export Set appOlk = CreateObject("Outlook.Application") Set nms = appOlk.GetNamespace("MAPI") Set fld = nms.PickFolder If fld Is Nothing Then GoTo ErrorHandlerExit End If
'Test whether selected folder contains contact items If fld.DefaultItemType <> olAppointmentItem Then MsgBox "Folder is not a calendar folder" GoTo ErrorHandlerExit End If
lngCount = fld.Items.Count
If lngCount = 0 Then MsgBox "No appointments to export" GoTo ErrorHandlerExit Else Debug.Print lngCount & " appointments to export" End If
'Adjust i (row number) to be 1 less than the number of the first body row i = 4
'Iterate through contact items in Calendar folder, and export a few fields 'from each item to a row in the Calendar worksheet For Each itm In fld.Items If itm.Class = olAppointment Then 'Process item only if it is an appointment item ' i = i + 1
'j is the column number j = 2
Set rng = wks.Cells(i, j) If itm.Start <> "" Then rng.Value = itm.Start j = j + 1
Set rng = wks.Cells(i, j) 'col3 If itm.End <> "" Then rng.Value = itm.End j = j + 1
'C'est là que çà coince (Incompatibilité de type) !!!!!!! Set aptPtrn = itm.GetRecurrencePattern
Set rng = wks.Cells(i, j) 'col4 If aptPtrn.StartTime <> "" Then rng.Value = aptPtrn.StartTime j = j + 1
Set rng = wks.Cells(i, j) 'col5 If aptPtrn.EndTime <> "" Then rng.Value = aptPtrn.EndTime j = j + 1
Set rng = wks.Cells(i, j) 'col6 If aptPtrn.RecurrenceType <> "" Then rng.Value = aptPtrn.RecurrenceType j = j + 1
Set rng = wks.Cells(i, j) 'col7 If aptPtrn.NoEndDate <> "" Then rng.Value = aptPtrn.NoEndDate j = j + 1
Set rng = wks.Cells(i, j) 'col8 If itm.Duration <> "" Then rng.Value = itm.Duration j = j + 1
Set rng = wks.Cells(i, j) 'col9 If itm.CreationTime <> "" Then rng.Value = itm.CreationTime j = j + 1
Set rng = wks.Cells(i, j) 'col10 If itm.Subject <> "" Then rng.Value = itm.Subject j = j + 1
Set rng = wks.Cells(i, j) 'col11 If itm.Location <> "" Then rng.Value = itm.Location j = j + 1
Set rng = wks.Cells(i, j) 'col12 If itm.Categories <> "" Then rng.Value = itm.Categories j = j + 1
Set rng = wks.Cells(i, j) 'col13 If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring j = j + 1
Set rng = wks.Cells(i, j) 'col14 On Error Resume Next 'The next line illustrates the syntax for referencing 'a custom Outlook field If itm.UserProperties("CustomField") <> "" Then rng.Value = itm.UserProperties("CustomField") End If j = j + 1
Set rng = wks.Cells(i, j) 'col15 rng.FormulaR1C1Local = "=NB.SI(L3C14:LC14,LC14)" End If i = i + 1 Next itm
ErrorHandlerExit: Exit Sub
ErrorHandler: If Err.Number = 429 Then 'Application object is not set by GetObject; use CreateObject instead If appWord Is Nothing Then Set appWord = CreateObject("Word.Application") Resume Next ElseIf appExcel Is Nothing Then Set appExcel = CreateObject("Excel.Application") Resume Next End If Else MsgBox "Error No: " & Err.Number & "; Description: " Resume ErrorHandlerExit End If
End Sub
Public Function TestFileExists(strFile As String) As Boolean 'Created by Helen Feddema 9-1-2004 'Last modified 9-1-2004 'Tests for existing of a file, using the FileSystemObject
Dim fso As New Scripting.FileSystemObject Dim fil As Scripting.File
On Error Resume Next
Set fil = fso.GetFile(strFile) If fil Is Nothing Then TestFileExists = False Else TestFileExists = True End If
End Function
Philippe
Merci Circé pour cette piste,
Que j'avais en fait déjà explorée, mais qui n'avait pas donné satisfaction car : - l'élimination des doublons ne se fait correctement (why ?) - et que le fichier d'archive comporte lui même des doublons.
Le passage par Excel a en fait pour but de sélectionner les items a récupérer de l'autre coté.
Philippe
Bonjour Philippe,
Ta procédure me paraît bien compliquée !! Pourquoi passer par Excel ?.. Pourquoi faut-il une macro ?... Pourquoi faire simple quand on peut faire compliqué ?... ;D
Il suffit que tu importes dans ton pst en cours ton fichier pst sauvegaqrdé en refusant les doublons. C'est aussi bête que ça ou alors j'ai rien compris à ton problème !
Menu Fichier, Importer et exporter Importer depuis un autre programme ou fichier Fichier de données personnel (pst) Ne pas importer les doublons OUvrir le dossier et choisir Calendrier
C'est tout.
Circé http://faqword.free.fr
Merci Circé pour cette piste,
Que j'avais en fait déjà explorée, mais qui n'avait pas donné
satisfaction car :
- l'élimination des doublons ne se fait correctement (why ?)
- et que le fichier d'archive comporte lui même des doublons.
Le passage par Excel a en fait pour but de sélectionner les items a
récupérer de l'autre coté.
Philippe
Bonjour Philippe,
Ta procédure me paraît bien compliquée !!
Pourquoi passer par Excel ?.. Pourquoi faut-il une macro ?...
Pourquoi faire simple quand on peut faire compliqué ?... ;D
Il suffit que tu importes dans ton pst en cours ton fichier pst
sauvegaqrdé en refusant les doublons. C'est aussi bête que ça ou alors
j'ai rien compris à ton problème !
Menu Fichier, Importer et exporter
Importer depuis un autre programme ou fichier
Fichier de données personnel (pst)
Ne pas importer les doublons
OUvrir le dossier et choisir Calendrier
Que j'avais en fait déjà explorée, mais qui n'avait pas donné satisfaction car : - l'élimination des doublons ne se fait correctement (why ?) - et que le fichier d'archive comporte lui même des doublons.
Le passage par Excel a en fait pour but de sélectionner les items a récupérer de l'autre coté.
Philippe
Bonjour Philippe,
Ta procédure me paraît bien compliquée !! Pourquoi passer par Excel ?.. Pourquoi faut-il une macro ?... Pourquoi faire simple quand on peut faire compliqué ?... ;D
Il suffit que tu importes dans ton pst en cours ton fichier pst sauvegaqrdé en refusant les doublons. C'est aussi bête que ça ou alors j'ai rien compris à ton problème !
Menu Fichier, Importer et exporter Importer depuis un autre programme ou fichier Fichier de données personnel (pst) Ne pas importer les doublons OUvrir le dossier et choisir Calendrier
C'est tout.
Circé http://faqword.free.fr
Circé
Re...
Il se trouve que Philippe a formulé :
Merci Circé pour cette piste,
Que j'avais en fait déjà explorée, mais qui n'avait pas donné satisfaction car : - l'élimination des doublons ne se fait correctement (why ?)
Sans doute, ce ne sont pas de "vrais" doublons.
- et que le fichier d'archive comporte lui même des doublons.
Le passage par Excel a en fait pour but de sélectionner les items a récupérer de l'autre coté.
Dans ce cas, je suppose que tu parles de ménage manuel. Mais ce ménage, tu peux très bien le faire dans Outlook.
Si tu tiens à Excel, ouvre ton fichier d'archives avec Outlook (Menu Fichier, Ouvrir, fichier de Données Outlook), puis exporte-le vers Excel : Menu Fichier, Importer et exporter, exporter des données vers un fichier, Excel, etc.
Ouvre le fichier Excel, fais ton ménage. Il ne te reste plus qu'à l'importer depuis Outlook.
Je ne vois toujours pas ce que la macro peut ajouter.
Circé
Philippe
Bonjour Philippe,
Ta procédure me paraît bien compliquée !! Pourquoi passer par Excel ?.. Pourquoi faut-il une macro ?... Pourquoi faire simple quand on peut faire compliqué ?... ;D
Il suffit que tu importes dans ton pst en cours ton fichier pst sauvegaqrdé en refusant les doublons. C'est aussi bête que ça ou alors j'ai rien compris à ton problème !
Menu Fichier, Importer et exporter Importer depuis un autre programme ou fichier Fichier de données personnel (pst) Ne pas importer les doublons OUvrir le dossier et choisir Calendrier
C'est tout.
Circé http://faqword.free.fr
Re...
Il se trouve que Philippe a formulé :
Merci Circé pour cette piste,
Que j'avais en fait déjà explorée, mais qui n'avait pas donné
satisfaction car :
- l'élimination des doublons ne se fait correctement (why ?)
Sans doute, ce ne sont pas de "vrais" doublons.
- et que le fichier d'archive comporte lui même des doublons.
Le passage par Excel a en fait pour but de sélectionner les items a
récupérer de l'autre coté.
Dans ce cas, je suppose que tu parles de ménage manuel. Mais ce ménage,
tu peux très bien le faire dans Outlook.
Si tu tiens à Excel, ouvre ton fichier d'archives avec Outlook (Menu
Fichier, Ouvrir, fichier de Données Outlook), puis exporte-le vers
Excel : Menu Fichier, Importer et exporter, exporter des données vers
un fichier, Excel, etc.
Ouvre le fichier Excel, fais ton ménage.
Il ne te reste plus qu'à l'importer depuis Outlook.
Je ne vois toujours pas ce que la macro peut ajouter.
Circé
Philippe
Bonjour Philippe,
Ta procédure me paraît bien compliquée !!
Pourquoi passer par Excel ?.. Pourquoi faut-il une macro ?...
Pourquoi faire simple quand on peut faire compliqué ?... ;D
Il suffit que tu importes dans ton pst en cours ton fichier pst
sauvegaqrdé en refusant les doublons. C'est aussi bête que ça ou
alors j'ai rien compris à ton problème !
Menu Fichier, Importer et exporter
Importer depuis un autre programme ou fichier
Fichier de données personnel (pst)
Ne pas importer les doublons
OUvrir le dossier et choisir Calendrier
Que j'avais en fait déjà explorée, mais qui n'avait pas donné satisfaction car : - l'élimination des doublons ne se fait correctement (why ?)
Sans doute, ce ne sont pas de "vrais" doublons.
- et que le fichier d'archive comporte lui même des doublons.
Le passage par Excel a en fait pour but de sélectionner les items a récupérer de l'autre coté.
Dans ce cas, je suppose que tu parles de ménage manuel. Mais ce ménage, tu peux très bien le faire dans Outlook.
Si tu tiens à Excel, ouvre ton fichier d'archives avec Outlook (Menu Fichier, Ouvrir, fichier de Données Outlook), puis exporte-le vers Excel : Menu Fichier, Importer et exporter, exporter des données vers un fichier, Excel, etc.
Ouvre le fichier Excel, fais ton ménage. Il ne te reste plus qu'à l'importer depuis Outlook.
Je ne vois toujours pas ce que la macro peut ajouter.
Circé
Philippe
Bonjour Philippe,
Ta procédure me paraît bien compliquée !! Pourquoi passer par Excel ?.. Pourquoi faut-il une macro ?... Pourquoi faire simple quand on peut faire compliqué ?... ;D
Il suffit que tu importes dans ton pst en cours ton fichier pst sauvegaqrdé en refusant les doublons. C'est aussi bête que ça ou alors j'ai rien compris à ton problème !
Menu Fichier, Importer et exporter Importer depuis un autre programme ou fichier Fichier de données personnel (pst) Ne pas importer les doublons OUvrir le dossier et choisir Calendrier
C'est tout.
Circé http://faqword.free.fr
JièL Goubert
Bonjoir(c) Circé
Le 11/09/2005 16:52 vous avez écrit ceci :
- l'élimination des doublons ne se fait correctement (why ?)
Sans doute, ce ne sont pas de "vrais" doublons.
je suppose aussi
- et que le fichier d'archive comporte lui même des doublons.
Le passage par Excel a en fait pour but de sélectionner les items a récupérer de l'autre coté.
Pourquoi passer par excel ? Dans Outlook, menu Fichier, Ouvrir, fichier de données Outlook (*.pst), choisir le fichier d'archive, dans le dossier choisir un affichage par catégories afin de pouvoir sélectionner les données à copier/coller dans l'autre fichier .PST
Je ne vois toujours pas ce que la macro peut ajouter.
moi non plus, surtout si ça ne peut pas être dédoublonner automatiquement
-- JièL / Jean-Louis GOUBERT La FAQ Outlook est la : http://faq.outlook.free.fr/
Bonjoir(c) Circé
Le 11/09/2005 16:52 vous avez écrit ceci :
- l'élimination des doublons ne se fait correctement (why ?)
Sans doute, ce ne sont pas de "vrais" doublons.
je suppose aussi
- et que le fichier d'archive comporte lui même des doublons.
Le passage par Excel a en fait pour but de sélectionner les items a
récupérer de l'autre coté.
Pourquoi passer par excel ?
Dans Outlook, menu Fichier, Ouvrir, fichier de données Outlook (*.pst),
choisir le fichier d'archive, dans le dossier choisir un affichage par
catégories afin de pouvoir sélectionner les données à copier/coller dans
l'autre fichier .PST
Je ne vois toujours pas ce que la macro peut ajouter.
moi non plus, surtout si ça ne peut pas être dédoublonner automatiquement
--
JièL / Jean-Louis GOUBERT
La FAQ Outlook est la : http://faq.outlook.free.fr/
- l'élimination des doublons ne se fait correctement (why ?)
Sans doute, ce ne sont pas de "vrais" doublons.
je suppose aussi
- et que le fichier d'archive comporte lui même des doublons.
Le passage par Excel a en fait pour but de sélectionner les items a récupérer de l'autre coté.
Pourquoi passer par excel ? Dans Outlook, menu Fichier, Ouvrir, fichier de données Outlook (*.pst), choisir le fichier d'archive, dans le dossier choisir un affichage par catégories afin de pouvoir sélectionner les données à copier/coller dans l'autre fichier .PST
Je ne vois toujours pas ce que la macro peut ajouter.
moi non plus, surtout si ça ne peut pas être dédoublonner automatiquement
-- JièL / Jean-Louis GOUBERT La FAQ Outlook est la : http://faq.outlook.free.fr/
