Forum

Αναζήτηση στο ms-office.gr

Πάμε!
ms-office.gr > Forum > Microsoft Office > Visual Basic for Applications (VBA) > [Excel - VBA] Σφάλμα κατα την δημιουργία email στο outlook

Visual Basic for Applications (VBA) Ερωτήσεις / Απαντήσεις σε σχέση με τη χρήση της VBA.

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 03-11-17, 20:43
Όνομα: Βασίλης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 08-06-2012
Μηνύματα: 53
Προεπιλογή Σφάλμα κατα την δημιουργία email στο outlook

Καλησπέρα σε όλους,

Είχα δημιουργήσει εναν κώδικα ώστε να διαβάζει συγκεκριμένο range σέ ένα φύλλο εργασίας και να δημιουργεί ένα email στο outlook. Λειτουργούσε κανονικά μέχρι την σημερινή όπου εμφάνισε σφάλμα, προφανώς κάποια ρύθμιση στο excel ή δεν ξερω που αλλου αλλαξε και προκάλεσε το σφάλμα. Αυτό το στηρίζω στο γεγονός ότι έχω περισσότερα από ένα αρχεία xlsm στα οποία έχω στο καθένα ξεχωριστά τον κώδικα αυτόν και δεν τρέχει σε κανένα.
Αν έχω καταλάβει σωστά αυτό στιγμή δημιουργή ένα temp αρχείο HTML με το body του email και απο εκει το αντιγράφει και το επικολλεί στο outlook. Αυτό είναι που άλλαξε σήμερα. Δεν γίνεται η επικόλληση του κειμένου του email.
Τα emails μπαινουν κανονικά , ο τίτλος επίσης και η υπογραφή.

Θα ήθελα την βοηθειά σας ώστε να ξαναλειτουργήσει η μακροεντολή.

Παρακάτω ο κώδικας που χρησιμοποιώ το μύνημα του σφάλματος και τα libraries
Κώδικας:
Option Explicit

    Public rFullPath As String ' full filepath of report file
    Public rN As Integer ' ubound number of report file
    Public rFileName As String ' filename of report file
    Public rUBound As Integer
    
    Public TWBmod As Workbook ' 
    Public TFolderPath As String ' 
    Public TFilename As String ' name of the TempFile
    Public TFullPath As String '
    Public TUbound As Integer
    
    Public rng As Range
    Public subject As Object
    Public OutApp As Object
    Public OutMail As Object
    Public receiversTO, receiversCC, receiversBCC As Object



Sub Mail_Selection_Range_Outlook_Body()
    Dim LR As Integer
    Sheets("Email").Select
    LR = Sheets("Email").Cells(rows.Count, "a").End(xlUp).Row - 3
    MsgBox (LR)

Set rng = Nothing

Set rng = Sheets("Email").Range("a1:h" & LR).SpecialCells(xlCellTypeVisible)

Set subject = Sheets("Email").Range("a" & LR + 3)
Set receiversTO = Sheets("Argies").Range("k1")
Set receiversCC = Sheets("Argies").Range("k2")
Set receiversBCC = Sheets("Argies").Range("k3")

If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
    '.BodyFormat = olFormatHTML
    .Display
    .To = receiversTO
    .CC = receiversCC
    .BCC = receiversBCC
    .subject = subject
    .Display
    .HTMLBody = RangetoHTML(rng) & .HTMLBody
    '.Attachments.Add rFullPath
        
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    
    '.Send
End With

On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End
End Sub

Function RangetoHTML(rng As Range)
' By Ron de Bruin.
    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"
    
    
        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
Συνημμένα Thumbnails
Σφάλμα κατα την δημιουργία email στο outlook-email-2017-11-03_20-32-15.gif   Σφάλμα κατα την δημιουργία email στο outlook-email-2017-11-03_20-32-54.jpg   Σφάλμα κατα την δημιουργία email στο outlook-email-2017-11-03_20-34-55.gif   Σφάλμα κατα την δημιουργία email στο outlook-email-2017-11-03_20-41-48.gif  
Απάντηση με παράθεση
  #2  
Παλιά 24-11-17, 09:38
Το avatar του χρήστη Spirosgr
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 1.910
Προεπιλογή

Ο κώδικας, έχει κάποια συντακτικά μικρολαθάκια,
αλλά δουλεύει κανονικά. (*βλέπε εικόνα)

Αν άλλαξες τις ρυθμίσεις Excel-Office, δεν το ξέρει κανείς...

Ακόμα, θα πρέπει να ξέρεις ότι το body, μπαίνει σαν πίνακας και «διαβάζει» ό,τι βλέπει.
Αυτό σημαίνει, ότι η στήλη Α στο φύλλο Email,
θα πρέπει να είναι ανοιχτή, σε όλο το πλάτος της (AutoFit)
Συνημμένα Thumbnails
Σφάλμα κατα την δημιουργία email στο outlook-screenshot_1.jpg  
__________________
Spirosgr
spirostsiligiannis@gmail.com

Τελευταία επεξεργασία από το χρήστη Spirosgr : 24-11-17 στις 15:02. Αιτία: Ορθογραφία-Σύνταξη
Απάντηση με παράθεση
  #3  
Παλιά Χθες, 12:52
Όνομα: Βασίλης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 08-06-2012
Μηνύματα: 53
Προεπιλογή

Ευχαριστώ για την απαντηση .
Από ότι κατάλαβα κάτι είχε να κανει με αλλαγή στα libraries αν το λεω καλά Option -> Tools..
όλα καλά τώρα.
Απάντηση με παράθεση
Απάντηση στο θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[Excel - VBA] δημιουργία email στο outlook με excel macro Βασίλης Καραχάλιος Visual Basic for Applications (VBA) 0 21-07-16 23:49
Σφάλμα σε κώδικα Dimitriss Access - Ερωτήσεις / Απαντήσεις 2 04-01-16 02:02
Με μακροεντολή δημιουργία επαφής του Outlook ΤΙΜΟΣ Access - Ερωτήσεις / Απαντήσεις 0 15-09-15 18:52
[ Εκθέσεις ] Ταξινόμηση κατά την δημιουργία xristos Access - Ερωτήσεις / Απαντήσεις 0 24-09-14 21:24
spam email στο outlook 2007 marpapa Outlook - Ερωτήσεις / Απαντήσεις 3 29-11-11 17:52


Η ώρα είναι 07:57.