Discussion :

[Promise]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[Promise]

Pour corriger l'erreur, Erreur d'exécution '91':
Variable objet ou variable de bloc With non définie, il suffit de modifier la ligne suivante dans la fonction WriteFileExcel() :
Set MonExcel = New Excel.Application par Set MonExcel = Excel.Application pour que le code marche. Plus besoin de recharger Outlook.

Merci.