Bonjour,
Voila plusieurs jours que je suis sur mon code et je ne trouve pas l'erreur.
Je veux créer un fichier EXCEL pui envoyer un mail avec en le mettant en pièce jointe, le problème est que la pièce jointe reste en lecture seule.
Voici mon code, si vous pouvez m'aider ça serait trop le TOP.
'Connexion à la base de données
Set MCTOOL = New ADODB.Connection
fichier = Form2.Text1.Text
MCTOOL.ConnectionString = fichier
MCTOOL.Provider = "Microsoft.Jet.OLEDB.4.0"
MCTOOL.Open
'Création
d'une variable contenant la date sachant que Date sera modifier a terme
date_mc = Month(Date) & "/" & Day(Date) & "/" & Year(Date)
'Création d'un objet Excel
Dim ClasseurXLS As Excel.Application
Dim FeuilXLS As Excel.Worksheet 'Feuille Excel
Set ClasseurXLS = CreateObject("excel.application")
ClasseurXLS.Visible = False
ClasseurXLS.Workbooks.Add
'Requete dans la base avec copier/coller du resultat dans le fichier Excel
req = "SELECT Route, AWB, Shipper, [Last Status], [Flag Text], IATA, [CORRECT IATA], "
req = req + " [Dest Country], [Dest ZipCode], PostCode"
req = req + " From MCResultOverview"
req = req + " Where MCResultOverview.pckp_dt = #" + CStr(date_mc) + "#"
req = req + " AND [Origin Unit] = '" + rst![Origin Unit] + "'"
req = req + " ORDER BY Route, [Last Status], AWB"
Set rst2.ActiveConnection = MCTOOL
rst2.Open req, MCTOOL, adOpenKeyset, adLockReadOnly
ClasseurXLS.Cells(4, 1).CopyFromRecordset rst2
rst2.Close
'En tete des colonnes
ClasseurXLS.Cells(3, 1) = "Route"
ClasseurXLS.Cells(3, 2) = "N° AWB"
ClasseurXLS.Cells(3, 3) = "Expéditeur"
ClasseurXLS.Cells(3, 4) = "Statut"
ClasseurXLS.Cells(3, 5) = "Commentaires"
ClasseurXLS.Cells(3, 6) = "IATA"
ClasseurXLS.Cells(3, 7) = "IATA " & Chr(10) & "Correct"
ClasseurXLS.Cells(3, 8) = "Pays " & Chr(10) & "destination"
ClasseurXLS.Cells(3, 9) = "CP " & Chr(10) & " destination"
ClasseurXLS.Cells(3, 10) = "Code postal"
'mise en forme
With ClasseurXLS.Range("A3:J3")
.Interior.ColorIndex = 44
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
'permet de connaitre la dernière ligne rempli du fichier
i = 3
Do While ClasseurXLS.Cells(i, 2) <> ""
i = i + 1
Loop
'mise en forme
ClasseurXLS.Range("A3:J" & i).Borders(xlDiagonalDown).LineStyle = xlNone
ClasseurXLS.Range("A3:J" & i).Borders(xlDiagonalUp).LineStyle = xlNone
With ClasseurXLS.Range("A3:J" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ClasseurXLS.Range("A3:J" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ClasseurXLS.Range("A3:J" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ClasseurXLS.Range("A3:J" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ClasseurXLS.Range("A3:J" & i).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ClasseurXLS.Range("A3:J3").Borders(xlEdgeBottom).LineStyle = xlContinuous
With ClasseurXLS.Range("A1:B1")
.Interior.ColorIndex = 45
.Interior.Pattern = xlSolid
.Font.Bold = True
.Font.Name = "Arial"
.Font.Size = 11
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With ClasseurXLS.Range("C1:J1")
.Interior.ColorIndex = 44
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
.Font.Name = "Arial"
.Font.Size = 16
End With
ClasseurXLS.Rows("1:1").RowHeight = 37.5
ClasseurXLS.Range("A1:B1").Merge
ClasseurXLS.Range("C1:J1").Merge
ClasseurXLS.Range("A1:B1") = Date
'ClasseurXLS.ActiveSheet.PageSetup.PrintArea = "$A$1:$J$" & i
'ClasseurXLS.Worksheets(1).PageSetup.PrintArea = "$A$1:$J$" & i
With ClasseurXLS.Range("A3:J" & i).Font
.Name = "Arial"
.Size = 8
End With
ClasseurXLS.Worksheets(1).PageSetup.PrintArea = "$A$1:$J$" & i
ClasseurXLS.Worksheets(1).PageSetup.Orientation = xlLandscape
ClasseurXLS.Worksheets(1).PageSetup.LeftMargin = 0.3
ClasseurXLS.Worksheets(1).PageSetup.RightMargin = 0.3
ClasseurXLS.Worksheets(1).PageSetup.FitToPagesWide = 1
ClasseurXLS.Range("C1") = "Miscodes sur " & rst![Origin Unit]
ClasseurXLS.Cells.Select
ClasseurXLS.Cells.EntireColumn.AutoFit
ClasseurXLS.Worksheets(1).Name = "MC"
ClasseurXLS.Worksheets(1).Select
ClasseurXLS.Worksheets(3).Delete
ClasseurXLS.Worksheets(2).Delete
'sauvegarde et fermeture du fichier excel
ClasseurXLS.DisplayAlerts = False
ClasseurXLS.ActiveWorkbook.SaveAs dossier_parent & Right(rst![Origin Unit], 3) & "_MC_" & Replace(Date, "/", "") & "_" & heure_mc & ".xls"
'on stocke le nom du fichier dans une variable
fichier = dossier_parent & Right(rst![Origin Unit], 3) & "_MC_" & Replace(Date, "/", "") & "_" & heure_mc & ".xls"
'ClasseurXLS.Sheets(1).Close
ClasseurXLS.Workbooks.Close
ClasseurXLS.Quit
Set FeuilXLS = Nothing
Set ClasseurXLS = Nothing
chemin_fichier = fichier
Agence = Right(rst![Origin Unit], 3)
'Envoi par email du fichier précédemment créé
Dim Message As New CDO.Message
With Message
.From = adresse_expediteur
.To = adresse_destinataire
.CC = adresse_destinataire_cc
.Subject = "ALERTES MC "
.AddAttachment (chemin_fichier)
.GetStream.SaveToFile "C:\MonMail.txt", adSaveCreateOverWrite
.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/sendusing
") = 2
.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/smtpserver
") = server_de_la_société
.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/smtpserverport
") = 25
.Configuration.Fields.Update
.Send
End With
Set Message = Nothing
Merci pour votre aide!!!!
Flo 