Microsoft 365 Problème avec la fonction publishobjects

dje14 · 27 Janvier 2025

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

jurassic pork · 27 Janvier 2025

Nicolas JACQUIN à dit:
Hello, j'avais buggé, mais dernier code présenté testé et approuvé pour ma part.

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 :

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

Ami calmant, J.P

Nicolas JACQUIN · 27 Janvier 2025

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 😱

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

dje14 · 28 Janvier 2025

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

dje14 · 28 Janvier 2025

Re

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

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

jurassic pork · 28 Janvier 2025

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?

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

dje14 · 28 Janvier 2025

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

idem, c'est fou ça quand même. 😡😱🤯

jurassic pork · 28 Janvier 2025

dje14 à dit:
idem, c'est fou ça quand même. 😡😱🤯

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 ?

dje14 · 28 Janvier 2025

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 ?

alors je suis sous windows 11 avec la version excel

il bloque avec erreur

jurassic pork · 28 Janvier 2025

j'ai bien une autre solution mais il faut installer un complément excel (gratuit) et il peut y avoir des soucis avec les accents sur les lettres majuscules.

dje14 · 28 Janvier 2025

jurassic pork à dit:
j'ai bien une autre solution mais il faut installer un complément excel (gratuit) et il peut y avoir des soucis avec les accents sur les lettres majuscules.

Malheureusement la solution ne me conviendra pas car le fichier est partagé sur one drive. Fichier collaboratif.

jurassic pork · 28 Janvier 2025

dje14 à dit:
Malheureusement la solution ne me conviendra pas car le fichier est partagé sur one drive. Fichier collaboratif.

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"

dje14 · 28 Janvier 2025

dje14 à dit:
Malheureusement la solution ne me conviendra pas car le fichier est partagé sur one drive. Fichier collaboratif.

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

jurassic pork · 28 Janvier 2025

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

essayer le lmf sur le disque local

dysorthographie · 28 Janvier 2025

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

dje14 · 29 Janvier 2025

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

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

Microsoft 365 Problème avec la fonction publishobjects

dje14

XLDnaute Nouveau

jurassic pork

XLDnaute Impliqué

Nicolas JACQUIN

XLDnaute Impliqué

dje14

XLDnaute Nouveau

dje14

XLDnaute Nouveau

jurassic pork

XLDnaute Impliqué

dje14

XLDnaute Nouveau

jurassic pork

XLDnaute Impliqué

dje14

XLDnaute Nouveau

jurassic pork

XLDnaute Impliqué

dje14

XLDnaute Nouveau

jurassic pork

XLDnaute Impliqué

dje14

XLDnaute Nouveau

jurassic pork

XLDnaute Impliqué

dysorthographie

XLDnaute Accro

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

dje14

XLDnaute Nouveau

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

Discussions similaires

Microsoft 365 Problème avec la fonction publishobjects

XLDnaute Nouveau

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Impliqué

XLDnaute Nouveau

XLDnaute Impliqué

XLDnaute Nouveau

XLDnaute Impliqué

XLDnaute Nouveau

XLDnaute Impliqué

XLDnaute Nouveau

XLDnaute Impliqué

XLDnaute Accro

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency