Microsoft 365 Problème avec la fonction publishobjects

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion dje14
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
D

dje14

XLDnaute Nouveau
Bonjour as tous,

Je souhaiterais copier un tableau excel dans un mail outlook via un bouton sans modification de forme.

J'ai pu voir que pour cela il fallait convertr en HTML.

Pour cela, j'ai pris des bouts de codes VBA sur le net (et oui malheureusement je ne suis pas un expert en la matière, mais plutôt autodidact sur le sujet).

Celle-ci fonctionne mais pas à tous les coups. Je rencontre un problème avec la fonction PublishObjects qui de temps en temps fonctionne mais la plupart du temps non et je n'en trouve malheureusement pas la raison.

Je vous copie ma fonction (qui peu vous sembler aberrante peut-être).

Sub envoimail1()
Dim Fichier As Variant

Dim i As Integer
Worksheets(Array("Feuil1")).Select
Range("A4: D66").Activate

Dim MaMessagerie As Object
Dim MonMessage As Object
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.CreateItem(0)
MonMessage.To = "toto@gmail.com"
MonMessage.Subject = "Bilan du " & Date
Corps = converthtml(Range("A4: D66"))
Corps = Corps & "<p>"
Corps = Replace(Corps, "align=center", "align=left")
MonMessage.Body = contenu
MonMessage.HTMLBody = Corps
MonMessage.Send
Set MaMessagerie = Nothing

MsgBox "Bilan envoyé"

End Sub

Function converthtml(plage As Object)
Dim lmf, fso, ts, r
Range("Feuil1").Cells(1, 1).Select
lmf = "abctext.html"
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, lmf, plage.Parent.Name, plage.Address, xlHtmlStatic, "Book1_26691", "")
.Publish (True)
.AutoRepublish = False
End With
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso. OpenTextfile(lmf)
r = ts.readall
ts.Close
converthtml = r
End Function

Merci d'avance pour votre aide.

Cdt
 
Trier par date Trier par votes
Nicolas JACQUIN à dit:
Hello, j'avais buggé, mais dernier code présenté testé et approuvé pour ma part.
Cliquez pour agrandir...
oui mais là tu ne fais pas ce que veux dje14 , c'est à dire mettre un tableau dans le corps du message en HTML. Toi tu mets en pièce jointe un classeur 😱
sa solution avec converthtml qui utilise PublishObjects m'a l'air bonne :
Avec ce code qui affiche dans un webBrowser d'un UserForm le HTML généré à partir d'une plage de données :
VB: 
Sub AfficheRngHTML()
Dim Corps As String
Corps = converthtml(Sheets("Médailles").Range("A1:F8"))
Load UsfHTML
UsfHTML.WebBrowser1.Navigate2 "about:&nbsp;": DoEvents
UsfHTML.WebBrowser1.Document.body.innerHTML = Corps
UsfHTML.Show

voici ce que j'obtiens :
ConvertHTML.png


et moi je n'ai pas l'air d'avoir de problèmes avec


Ami calmant, J.P
 
Vote positif 0 Vote négatif
jurassic pork à dit:
oui mais là tu ne fais pas ce que veux dje14 , c'est à dire mettre un tableau dans le corps du message en HTML. Toi tu mets en pièce jointe un classeur 😱
Cliquez pour agrandir...

Il a dit, je cite: J'ai pu voir que pour cela il fallait convertr en HTML

Il n'a pas dit forcément en html !

Moi je ne mets pas le classeur en pièce jointe, juste la plage demandé ( sinon y aurait un paquet de pages sur mon fichier testé ), c'est peut-être dans un nouveau classeur, mais juste la plage avec format comme demandé. 😉😉

Nico
 
Vote positif 0 Vote négatif
Bonjour à vous,

effectivement je me suis peut être mal exprimé. Je recherche bien à intégré mon tableau sous forme HTML dans outlook et non en pièce jointes.

Désolé pour la confusion.

Pour info ma case Option formule L1C1 n'est pas coché.

Malheureusement je ne peu pas vous fournir mon fichier pour des raisons de confidentialité sinon je vous l'aurez fourni.

je test les solutions de jurassic porc et je vous redit.

en tous les cas merci à vous.

Cdt
 
Vote positif 0 Vote négatif
Re

alors mon premier test est bien passé avec la modif, mais au bout d'un moment cela recommence:

1738054560614.png


1738054581828.png


Je ne comprend ce qui peu le déranger de temps en temps.

Est ce qu'il existerait pas une fonction différente qui pourrais palier le souci?

Cdt
 
Vote positif 0 Vote négatif
dje14 à dit:
Je ne comprend ce qui peu le déranger de temps en temps.

Est ce qu'il existerait pas une fonction différente qui pourrais palier le souci?
Cliquez pour agrandir...
Hello,
tu peux essayer de mettre une temporisation entre le add et le .publish
comme ceci par exemple :
VB: 
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, lmf, plage.Parent.name, plage.Address, xlHtmlStatic, "Book1_26691", "")
Pause 1.5 ' 1,5 secondes
.Publish (True)

Code: 
Sub Pause(Optional ByVal Period As Single = 1)
 Dim TimeOut  As Single
        TimeOut = Timer + Period
        Do: DoEvents: Loop Until TimeOut < Timer
End Sub

Si tu n'as plus le problème essai de diminuer la valeur de la pause ( par exemple 0.5) parce que 1,5 secondes c'est quand même beaucoup.

Ami calmant, J.P
 
Vote positif 0 Vote négatif
jurassic pork à dit:
Hello,
tu peux essayer de mettre une temporisation entre le add et le .publish
comme ceci par exemple :
VB: 
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, lmf, plage.Parent.name, plage.Address, xlHtmlStatic, "Book1_26691", "")
Pause 1.5 ' 1,5 secondes
.Publish (True)

Code: 
Sub Pause(Optional ByVal Period As Single = 1)
 Dim TimeOut  As Single
        TimeOut = Timer + Period
        Do: DoEvents: Loop Until TimeOut < Timer
End Sub

Si tu n'as plus le problème essai de diminuer la valeur de la pause ( par exemple 0.5) parce que 1,5 secondes c'est quand même beaucoup.

Ami calmant, J.P
Cliquez pour agrandir...

idem, c'est fou ça quand même. 😡😱🤯
 
Vote positif 0 Vote négatif
dje14 à dit:
idem, c'est fou ça quand même. 😡😱🤯
Cliquez pour agrandir...
Ce qui est bizarre c'est que moi je n'ai pas le problème. Quelle est ta version d'Excel et sous Quel O.S ? (Windows 7, 8 , 10 ou 11 ou Mac ?)
Dernier essai à faire sans With :
VB: 
Dim objPub As Object
Set objPub = ActiveWorkbook.PublishObjects.Add(xlSourceRange, lmf, plage.Parent.name, plage.Address, xlHtmlStatic, "Book1_26691", "")
Pause 1.5 ' 1,5 secondes
objPub.Publish True
objPub.AutoRepublish = False
tu ne fais l'opération qu'une fois où c'est appelé plusieurs fois (dans une boucle) ?
Il n'y a que du texte dans tes cellules ? combien de caractères par cellules ?
 
Dernière édition:
Vote positif 0 Vote négatif
jurassic pork à dit:
Ce qui est bizarre c'est que moi je n'ai pas le problème. Quelle est ta version d'Excel et sous Quel O.S ? (Windows 7, 8 , 10 ou 11 ou Mac ?)
Dernier essai à faire sans With :
VB: 
Dim objPub As Object
Set objPub = ActiveWorkbook.PublishObjects.Add(xlSourceRange, lmf, plage.Parent.name, plage.Address, xlHtmlStatic, "Book1_26691", "")
Pause 1.5 ' 1,5 secondes
objPub.Publish True
objPub.AutoRepublish = False
tu ne fais l'opération qu'une fois où c'est appelé plusieurs fois (dans une boucle) ?
Il n'y a que du texte dans tes cellules ? combien de caractères par cellules ?
Cliquez pour agrandir...
alors je suis sous windows 11 avec la version excel

1738063624937.png


il bloque avec erreur
1738063683487.png


1738063700323.png
 
Vote positif 0 Vote négatif
dje14 à dit:
Malheureusement la solution ne me conviendra pas car le fichier est partagé sur one drive. Fichier collaboratif.
Cliquez pour agrandir...
tiens justement ce ne serait pas le fait que le fichier soit sur OneDrive qui cause ton problème.
As-tu essayé de le mettre en local pour voir ou alors de mettre le fichier temporaire sur le disque local.
exemple :
VB: 
lmf = "c:\temp\abctext.html"
 
Dernière édition:
Vote positif 0 Vote négatif
dje14 à dit:
Malheureusement la solution ne me conviendra pas car le fichier est partagé sur one drive. Fichier collaboratif.
Cliquez pour agrandir...
je vous remet le code modifié car au bout d'un moment je fini par ne plus voir si j'ai fais une erreur.

J'ai peut être mal positionné certaine chose.

Des petits choses on été ajouté, mais je ne pense pas que cela va avoir une incidence.

Sub envoimail1()

If Range("H3") = "0" Then

Dim Fichier As Variant

Dim i As Integer
Worksheets(Array("Feuil1")).Select
Range("A4:E67").Activate

Dim MaMessagerie As Object
Dim MonMessage As Object
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.CreateItem(0)
MonMessage.To = "toto@gmail.com"
MonMessage.Subject = "Bilan "
For i = 1 To 1000
Corps = converthtml(Sheets("Feuil1").Range("A4:E67"))
Next i
Corps = Corps & "<p>"
Corps = Replace(Corps, "align=center", "align=left")
MonMessage.Body = contenu
MonMessage.HTMLBody = Corps
MonMessage.Send
Set MaMessagerie = Nothing

MsgBox "Bilan envoyé"

Else
MsgBox "Toutes les cases ne sont pas renseignées, BILAN NON ENVOYÉ"
End If

End Sub

Sub Pause(Optional ByVal Period As Single = 1)
Dim TimeOut As Single
TimeOut = Timer + Period
Do: DoEvents: Loop Until TimeOut < Timer
End Sub

Function converthtml(plage As Object)
Dim lmf, fso, ts, r
Sheets(plage.Parent.Name).Activate
lmf = "abctext.html"
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, lmf, plage.Parent.Name, plage.Address, xlHtmlStatic, "Book1_26691", "")
Pause 1,5 ' 1,5 secondes
.Publish (True)
.AutoRepublish = False
End With
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso. OpenTextfile(lmf)
r = ts.readall
ts.Close
converthtml = r
End Function
 
Vote positif 0 Vote négatif
dje14 à dit:
je vous remet le code modifié car au bout d'un moment je fini par ne plus voir si j'ai fais une erreur.

J'ai peut être mal positionné certaine chose.

Des petits choses on été ajouté, mais je ne pense pas que cela va avoir une incidence.

Sub envoimail1()

If Range("H3") = "0" Then

Dim Fichier As Variant

Dim i As Integer
Worksheets(Array("Feuil1")).Select
Range("A4:E67").Activate

Dim MaMessagerie As Object
Dim MonMessage As Object
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.CreateItem(0)
MonMessage.To = "toto@gmail.com"
MonMessage.Subject = "Bilan "
For i = 1 To 1000
Corps = converthtml(Sheets("Feuil1").Range("A4:E67"))
Next i
Corps = Corps & "<p>"
Corps = Replace(Corps, "align=center", "align=left")
MonMessage.Body = contenu
MonMessage.HTMLBody = Corps
MonMessage.Send
Set MaMessagerie = Nothing

MsgBox "Bilan envoyé"

Else
MsgBox "Toutes les cases ne sont pas renseignées, BILAN NON ENVOYÉ"
End If

End Sub

Sub Pause(Optional ByVal Period As Single = 1)
Dim TimeOut As Single
TimeOut = Timer + Period
Do: DoEvents: Loop Until TimeOut < Timer
End Sub

Function converthtml(plage As Object)
Dim lmf, fso, ts, r
Sheets(plage.Parent.Name).Activate
lmf = "abctext.html"
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, lmf, plage.Parent.Name, plage.Address, xlHtmlStatic, "Book1_26691", "")
Pause 1,5 ' 1,5 secondes
.Publish (True)
.AutoRepublish = False
End With
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso. OpenTextfile(lmf)
r = ts.readall
ts.Close
converthtml = r
End Function
Cliquez pour agrandir...
essayer le lmf sur le disque local
 
Vote positif 0 Vote négatif
Bonjour,

Un composant activeX ne peut pas créer un objet - Macros et VBA Excel

Je viens d'installer OUTLOOK 2007 pour automatiser l'envoi de mail pour mon association 1901, j'ai installé la reférence "Outlook 12.0 Object Library" j'ai recopié de l' aide DVP ce début de code Code
www.developpez.net
VB: 
Sub azerty()
Debug.Print RangetoHTML(ActiveSheet.UsedRange)
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
Vote positif 0 Vote négatif
dysorthographie à dit:
Bonjour,

Un composant activeX ne peut pas créer un objet - Macros et VBA Excel

Je viens d'installer OUTLOOK 2007 pour automatiser l'envoi de mail pour mon association 1901, j'ai installé la reférence "Outlook 12.0 Object Library" j'ai recopié de l' aide DVP ce début de code Code
www.developpez.net
VB: 
Sub azerty()
Debug.Print RangetoHTML(ActiveSheet.UsedRange)
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
Cliquez pour agrandir...
Bonjour,

comme je le disais au début de mon poste, je suis autodidacte sur le sujet et j’admets ne pas comprendre le code que vous venez de m'envoyer.

ce code va me permettre de déboguer?

ou dois-je le placer? Ou dois-je remplacer une partie du moins par celui-ci?

Une idée me vient suite à vos idées. Serait il possible que cela bloque du fait que le fichier soit sur un sharepoint?

Dans ce cas, il conviendrait peut-être que je crée une copie du fichier de manière temporaire dans le local PC afin de l'envoyé et ensuite le supprimer.

Quand pensez-vous?

Cdt
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
527
arnoldbrice19
A
D
  • Résolu(e)
Microsoft 365 Problème interférences entre macros
Réponses
14
Affichages
147
Phil69970
Phil69970
Cédric06400
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
431
Franc58
F
R
  • Question Question
Microsoft 365 Inserer copie d'ecran ou plage de cellules dans mail
Réponses
4
Affichages
943
romubzh35
R
S
  • Résolu(e)
Microsoft 365 Fusion de 2 macro VBA (selection envoi de mail + envoie de fichier PDF)
Réponses
6
Affichages
2 K
soNZOOO
S
M
  • Question Question
XL 2016 Envoi courriel copier/coller avec mise en forme (corps couuriel)
Réponses
2
Affichages
1 K
MONTREAL2020
M
I
  • Question Question
XL 2019 Envoyer image et mise en forme conditionnelle dans un mail
Réponses
1
Affichages
914
patricktoulon
patricktoulon
M
  • Question Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
828
Oneida
Oneida
Philou0607
  • Question Question
XL 2010 Sauts de ligne dans envoi mail sous VBA
Réponses
5
Affichages
5 K
Staple1600
Staple1600
T
  • Question Question
Envoie d'un mail vba sous condition
Réponses
2
Affichages
4 K
TEMAGOULTFARID
T
R
  • Question Question
XL 2016 Envoyer un fichier excel par email via outlook
Réponses
8
Affichages
3 K
rayms
R
A
  • Question Question
XL 2010 Générer mail avec corps de mail / destinataire et PJ
Réponses
0
Affichages
700
Alghorn
A
chris6999
  • Question Question
Microsoft 365 Envoi mail depuis boite Outlook pré-identifiée
Réponses
3
Affichages
2 K
chris6999
chris6999
chris6999
  • Question Question
Microsoft 365 Envoi mail depuis boite Outlook pré-identifiée
Réponses
0
Affichages
674
chris6999
chris6999
F
  • Question Question
XL 2010 Envoi d'un mail notifiant une modification à plusieurs destinataires
Réponses
5
Affichages
1 K
Hasco
Hasco
chris6999
  • Question Question
Microsoft 365 MSG Outlook via VBA pb de lien et de signature
Réponses
0
Affichages
727
chris6999
chris6999
D
  • Question Question
Résolu : email automatique sous excel
Réponses
13
Affichages
1 K
DG-59
D
Magic_Doctor
  • Question Question
Problème avec boucle tordue et la fonction Switch
Réponses
5
Affichages
1 K
Magic_Doctor
Magic_Doctor
N
  • Question Question
XL 2016 Problème macro ouverture Outlook a l'arrièce plan avec la fonction Shell
Réponses
2
Affichages
3 K
NicoleBelge
N
Claudy
  • Question Question
Compile error Can't find project or library
Réponses
11
Affichages
4 K
Dranreb
Dranreb
Retour