Bonjour à tous,
Je suis nouveau sur ce forum et suis débutant en VBA/Outlook. J'exécute une fonction qui prend en paramètre le nom du fichier à créer en Excel. La fonction a pour fonctionnalités d'ouvrir et de parcourir un fichier texte puis de mettre le contenu dans un fichier Excel qui sera créé avec le nom reçu en paramètre. Lors de la création du fichier Excel, on insère à la sixième colonne des cases à cocher.
Voici la fonction :
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
| Function WriteFileExcel(ByVal strNameFile As String) As String
'---------------------------------------------------------------------------------------
' Fonction : WriteFileExcel(ByVal strNameFile As String)
' Auteur :
' Date :
' Détail : Parcours du fichier temporaire(ListeViadeo.txt) et création du fichier excel de toute la liste des données utiles
'---------------------------------------------------------------------------------------
'
'Déclaration des variables
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.file
Dim oTXT As Scripting.TextStream
Dim longFichier As Long
Dim strFichier, stExistFich, stFichierComp As String
Dim dateInscription, strPrenom, strNom, strFonction, strSociete As String
Dim i As Integer
Dim strTab() As String
Dim MonExcel As Object
Dim Cellule As Range
'Instanciation du FSO et de MonExcel
Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile("C:\Temp\TempViadeo\ListeViadeo.txt")
Set MonExcel = New Excel.Application
'Rendre visible l'application excel
'MonExcel.Application.Visible = True
'Création du fichier Excel
MonExcel.Workbooks.Add 'Ouverture du classeur
MonExcel.ActiveWorkbook.ActiveSheet.Range("A1").Value = "Prénom "
MonExcel.ActiveWorkbook.ActiveSheet.Range("B1").Value = "Nom "
MonExcel.ActiveWorkbook.ActiveSheet.Range("C1").Value = "Fonction "
MonExcel.ActiveWorkbook.ActiveSheet.Range("D1").Value = "Société "
MonExcel.ActiveWorkbook.ActiveSheet.Range("E1").Value = "Date Inscription "
MonExcel.ActiveWorkbook.ActiveSheet.Range("F1").Value = "Cocher les fonctions qualifiées "
'Initialisation du compteur i d"'incrémentation des lignes du classeur
i = 2
'Initialisation du compteur j d"'incrémentation d"espace à laisser en haut de chaque case à cocher
j = 14
'Ouverture du fichier ListeViadeo.txt
Set oTXT = oFl.OpenAsTextStream(ForReading)
With oTXT
While Not .AtEndOfStream
strFichier = .ReadLine
strTab = Split(strFichier, ",")
strPrenom = strTab(0)
strNom = strTab(1)
strFonction = strTab(2)
strSociete = strTab(3)
dateInscription = strTab(4)
MonExcel.ActiveWorkbook.ActiveSheet.Range("A" & i).Value = strPrenom
MonExcel.ActiveWorkbook.ActiveSheet.Range("B" & i).Value = strNom
MonExcel.ActiveWorkbook.ActiveSheet.Range("C" & i).Value = strFonction
MonExcel.ActiveWorkbook.ActiveSheet.Range("D" & i).Value = strSociete
MonExcel.ActiveWorkbook.ActiveSheet.Range("E" & i).Value = dateInscription
'MonExcel.ActiveWorkbook.ActiveSheet.Range("F" & i).Select
' MonExcel.ActiveWorkbook.ActiveSheet.Checkboxes.Add(20, j, 24, 17.25).Select
' j = j + 15
Set Cellule = MonExcel.ActiveWorkbook.ActiveSheet.Range("F" & i)
'Cellule = MonExcel.ActiveWorkbook.ActiveSheet.Range("F" & i).Value
'For Each Cellule In Range("F" & i & ":F" & i + 1)
With Cellule
.Select
MonExcel.ActiveWorkbook.ActiveSheet.Checkboxes.Add(.Left, .Top, .Width, .Height).Select
End With
With Selection
.LinkedCell = Cellule.Offset(0, 1).Address
.Characters.Text = " "
'.Characters.Text = "Case" & Cellule.Row
End With
'Next Cellule
'Incrémentatiton du compteur
i = i + 1
Wend
End With
'Gestion des erreurs
On Error Resume Next
Kill "C:\MailViadeo\" & strNameFile
On Error GoTo 0
MonExcel.ActiveWorkbook.SaveAs "C:\MailViadeo\" & strNameFile 'Enregistrement du fichier
'Fermeture du classeur
MonExcel.ActiveWorkbook.Close
stFichierComp = "C:\MailViadeo\" & strNameFile
stExistFich = Dir(stFichierComp)
'Vérifier si le fichier est créé
If stExistFich <> "" Then
WriteFileExcel = strNameFile
End If
'Vider l'instance
Set MonExcel = Nothing 'Vider l'instance MonExcel
Set Cellule = Nothing 'Vider l'instance Cellule
Set oFSO = Nothing 'Vider l'instance oFSO
Set oF1 = Nothing 'Vider l'instance oF1
Set oTXT = Nothing 'Vider l'instance oTXT
End Function |
Et voici comment je l'appelle :
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
| Sub Test()
Dim Today
'Création du fichier Excel des mails extraits
Today = Now
dateTab = Split(Today, " ")
Today = Replace(Today, "/", "-")
Today = Replace(Today, " ", "_")
Today = Replace(Today, ":", "-")
Today = "viadeo" & Today & ".xls"
' Appel de la fonction d'écriture dans le fichier Excel
strFichier = WriteFileExcel(Today)
If Len(strFichier) > 0 Then
MsgBox "Récupération des E-mails terminée!" & vbCr & "Création du fichier Excel " & Today & " dans C:\MailViadeo !"
End If
End Sub |
Mon problème est quand j'ouvre outlook et exécute la macro, j'ai le résultat attendu pour une première fois. Mais si je l'exécute pour une deuxième fois sans fermer outlook et le relancer, j'ai ce message d'erreur :
Erreur d'exécution '91':
Variable objet ou variable de bloc With non définie
à la ligne :
.LinkedCell = Cellule.Offset(0, 1).Address
Le problème ne se pose pas quand je ferme et relance outlook à chaque exécution de la macro.
Je ne sais pas s'il y aurait une fonction qui permettra de recharger outlook à la fin de l'exécution de la macro. Voilà à peu près mon problème. Si quelqu'un pourrait m'aider à résoudre ce problème pour me permettre d'avancer dans mon programme, je lui serai reconnaissant. Merci pour votre aide.
18/07/2011, 12h17
Actualiser ou recharger outlook 2007
00
