Bonjour,
j'ai mis en place il y a quelque temps une macro qui permet aux équipes de remonter toutes les prévisions qui passent hors système.
Le comptable choisi le type de prévision, effectue sa saisie (Compte / Montant / Date / Description)
Ensuite, il clique sur "VALIDER" et la prévisions s'affiche dans la listBox. Il peut saisir autant de prévision qu'il veut. Une fois qu'il a fini toutes ses saisies, il clique sur "ENVOYER". Là, commence mon problème.
Avant de migrer sous OFFICE 365, le comportement était le suivant après le clique sur "ENVOYER" :
- Un fichier csv est crée sous un répertoire pour être importé par le système de destination
- Une fenêtre d'envoi de mail avec une adresse destinataire et un texte déjà défini dans le code s'ouvre avec le même fichier csv en pièce jointe.
- l'utilisateur n'a plus qu'à envoyer son mail.
Après migration vers OFFICE 365 :
- L'utilisateur peut toujours saisir ses prévisions
- Cliquer sur le bouton "VALIDER" pour les afficher au niveau de la listBox
- MAIS quand il clique sur "ENVOYER", le fichier csv est bien généré au niveau du répertoire de destination pour intégration mais la fenetre d'envoi de mail OUTLOOK ne s'ouvre plus.
Pourriez- vous svp me venir en aide sur la partie du code qui ne fonctionnerait pas ?
Private Sub ENVOIMAIL_Click()
Dim wb As Workbook
Dim Shname As Variant
Dim N As Integer
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim fichierTemp1 As String
Dim fichierTemp2 As String
Dim i As Long
Dim outlook As Object
Dim Mail As Object
Dim w As Integer
If ListBox1.ListCount = 0 Then
MsgBox "Attention aucune donnée à envoyer."
Exit Sub
End If
ThisWorkbook.Activate
Shname = Array("Prévisions")
FileExtStr = ".csv": FileFormatNum = -4143
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'TempFilePath = Environ$("temp") & "\"
'TempFilePath = "\\unibail.fr\prog\ITF_DATA_HA\ITF_DIAPASON_IMPORT\CashmovementDivers\source\"
For N = LBound(Shname) To UBound(Shname)
TempFilePath = "C:\Users\test\Desktop\test\"
TempFileName = Format(Now, "yyyymmdd") & "_" & Format(Now, "hhmmss") & "_" & Forecast.Caption
ThisWorkbook.Sheets(Shname(N)).Copy
Set wb = ActiveWorkbook
wb.SaveAs Filename:=TempFilePath & TempFileName & FileExtStr, FileFormat:=xlCSV, CreateBackup:=False, Local:=True, ReadOnlyRecommended:=False
On Error Resume Next
wb.Close savechanges:=False
If N = LBound(Shname) Then
fichierTemp1 = TempFilePath & TempFileName & FileExtStr
Else:
If N = UBound(Shname) Then
fichierTemp2 = TempFilePath & TempFileName & FileExtStr
End If
End If
Next N
Set outlook = CreateObject("Outlook.Application")
Set Mail = outlook.CreateItem(0)
With Mail
.To = "test@test.com"
.Subject = TempFileName 'Format(Now, "yyyymmdd") & "_" & Format(Now, "hhmmss") & "_" & Forecast.Caption
.Body = "Bonjour," & vbCrLf & vbCrLf _
& "Veuillez trouver ci-joint le fichier des prévisions à intégrer dans Diapason." & vbCrLf & vbCrLf _
& "Cordialement. " & vbCrLf
.Attachments.Add fichierTemp1
.Attachments.Add fichierTemp2
.Display
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Forecast.Show
End Sub
Merci pour votre aide.
Bien cordialement.