Classeur Excel pour le modèle Outlook

Question

S'il vous plaît voir l'image ci-jointe pour référence.

J'ai un classeur Excel dans lequel j'ai besoin d'entrer des données chaque jour à la volée. Après avoir entré les données, j'ai besoin d'entrer à nouveau les données dans un modèle de perspectives et de les envoyer aux clients.

Mon modèle de perspective contient un tableau de base tel que vu dans l'image. Ce que je veux faire est après avoir entré les données dans Excel, cliquez sur le bouton et il ouvrira automatiquement le modèle de perspectives et remplira les données du cahier excel prêt à être envoyé.

J'ai copié et collé les données mais il commence à devenir incontrôlable car plusieurs centaines de ces emails doivent être faits chaque jour.

Toutes les suggestions seraient grandement appréciées.

Answer 1

est ici quelque chose que j'utilise des e-mails simples - assez générique, mais vous pouvez modifier comme vous le souhaitez.

Sélectionnez une ligne dans vos données et exécutez la macro. Ajustez les constantes HEADER_ROW et NUM_COLS en fonction de votre disposition.

Sub NotificationMail() 

    Const HEADER_ROW As Long = 1 '<< the row with column headers 
    Const NUM_COLS As Long = 7 '<< how many columns of data 

    Const olMailItem = 0 
    Const olFolderInbox = 6 

    Dim ol As Object, fldr, ns, msg 
    Dim html As String, c As Range, colReq As Long, hdr As Range 
    Dim rw As Range 

    On Error Resume Next 
    Set ol = GetObject(, "outlook.application") 
    On Error GoTo 0 

    If ol Is Nothing Then 
     On Error Resume Next 
     Set ol = CreateObject("outlook.application") 
     Set ns = ol.GetNamespace("MAPI") 
     Set fldr = ns.GetDefaultFolder(olFolderInbox) 
     fldr.display 
     On Error GoTo 0 
    End If 

    If ol Is Nothing Then 
     MsgBox "Couldn't start Outlook to compose mail!", vbExclamation 
     Exit Sub 
    End If 

    Set msg = ol.CreateItem(olMailItem) 

    Set rw = Selection.Cells(1).EntireRow 

    msg.Subject = "Here's your information" 

    html = "<style type='text/css'>" 
    html = html & "body, p {font:10pt calibri;padding:40px;}" 
    html = html & "table {border-collapse:collapse}" 
    html = html & "td {border:1px solid #000;padding:4px;}" 
    html = html & "</style>" 

    html = html & "<p>Your request has been updated:</p>" 
    html = html & "<table>" 


    For Each c In rw.Cells(1).Resize(1, NUM_COLS).Cells 
     If c.Column <> 4 Then '<<< EDIT to exclude ColD 
      Set hdr = rw.Parent.Cells(HEADER_ROW, c.Column) '<< get the header text for this cell 

      html = html & "<tr><td style='background-color:#DDD;width:200px;'>" & _ 
       hdr.Value & _ 
       "</td><td style='width:400px;'>" & Trim(c.Value) & "</td></tr>" 
     End If 'we want this cell 
    Next c 

    html = html & "</table>" 

    msg.htmlbody = html 
    msg.display 

End Sub 

Answer 2

ici est un code que j'ai pour référence

il montre comment créer des tableaux et comment traiter les cellules

a beaucoup de choses supplémentaires

étape juste à travers elle

Sub aTestEmail() 

     Dim outMail As Outlook.mailItem 
     Set outMail = Application.CreateItem(olMailItem) 
     outMail.BodyFormat = olFormatHTML 
     outMail.Display (False)      ' modeless 

     Dim wd As Document 
'  Set wd = Application.ActiveInspector.WordEditor 
     Set wd = outMail.GetInspector.WordEditor 

'  wd.Range.InsertBreak 3 ' section (continuous) 
'  wd.Range.InsertBreak 3 ' section (continuous) 


     For i = 0 To 9 
      wd.Range.InsertParagraphAfter 
     Next 

     debug_aTestEmail wd 


     Stop 

     Dim rng As Range 

     Set rng = wd.Range(2, 8) 
     rng.Select 
     Debug.Print rng.Text 
     rng.Collapse (1) ' 0 - left, 1 - right 
     rng.Select 

     wd.Content.Select 
'  Debug.Print wd.Content.Text 
'  wd.Range(wd.Characters(104).End, wd.Characters(150).End).Select 
'  wd.Range(wd.Words(5).Start, wd.Words(10).Start).Select 
'  wd.Range(wd.Words(5).Start, wd.Words(10).End).Select 
     wd.Range(wd.Words(5).End, wd.Words(10).End).Select 




'  wd.Range.Select 
'  wd.Sentences(1).Select 
'  wd.Sentences(1).Words(1).Select 
'  wd.Sentences(1).Words(5).Select 
'  wd.Sentences(1).Words(10).Select 


'  wd.Sentences(5).Characters(10).Select 
'  wd.Sentences(5).Characters(10).Select 
'  wd.Words(10).Select 
'  wd.Words(11).Select 
'  wd.Range.Words(10).Select 
'  wd.Range.Words(11).Select 

'  debug_aTestEmail wd 
'  wd.Characters(4).Select 

     wd.Tables.Add Range:=wd.Characters(8), NumRows:=5, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed 

     wd.Tables.Add Range:=wd.Characters(3), NumRows:=5, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed 

     wd.Tables(1).Range.Words(1).Select 
     wd.Tables(1).Range.Words(2).Select 

     wd.Tables(1).Columns(1).Cells(1).Select 
     wd.Tables(1).Columns(1).Cells(2).Select 
     wd.Tables(1).Columns(1).Cells(3).Select 
     wd.Tables(1).Columns(1).Cells(4).Select 
     wd.Tables(1).Columns(1).Cells(5).Select 


     Debug.Print wd.Sentences(1).Words.Count 
     Debug.Print wd.Words.Count 

     Dim tabl As Tables 
     Set tabl = wd.Tables 

     tabl(1).Style = "Grid Table 4 - Accent 3" ' get this name from "table design" tab (hover over whichever style you like and a tool tip will give you the name) 
'  tabl(1).ApplyStyleHeadingRows = True 
'  tabl(1).ApplyStyleLastRow = False 
'  tabl(1).ApplyStyleFirstColumn = True 
'  tabl(1).ApplyStyleLastColumn = False 
'  tabl(1).ApplyStyleRowBands = True 
'  tabl(1).ApplyStyleColumnBands = False 

     tabl(1).Range.InsertParagraph 
     tabl(1).Cell(1, 1).Range.InsertParagraph 
     tabl(1).Cell(2, 1).Range.InsertParagraph 
     tabl(1).Cell(3, 1).Range.InsertParagraph 


     tabl(1).Cell(1, 1).Range.InsertBefore "cell1" 
     tabl(1).Cell(2, 1).Range.InsertBefore "cell2" 
     tabl(1).Cell(3, 1).Range.InsertBefore "cell3" 
     tabl(1).Cell(4, 1).Range.InsertBefore "cell4" 
     tabl(1).Cell(5, 1).Range.InsertBefore "cell5" 

     tabl(2).Cell(1, 1).Range.InsertBefore "cell6" 
     tabl(2).Cell(2, 1).Range.InsertBefore "cell7" 
     tabl(2).Cell(3, 1).Range.InsertBefore "cell8" 
     tabl(2).Cell(4, 1).Range.InsertBefore "cell9" 
     tabl(2).Cell(5, 1).Range.InsertBefore "cell10" 


'  wd.Range.InsertBreak 3 ' section (continuous) 
'  wd.Range.InsertBreak 3 ' section (continuous) 

     debug_aTestEmail wd 

'  wd.Sections(2).Range.InsertBefore ("before" & vbCrLf & vbCrLf) 
'  wd.Sections(2).Range.InsertAfter ("after" & vbCrLf & vbCrLf) 

'  debug_aTestEmail wd 

'  wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.1" & vbCrLf & vbCrLf) 
'  wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.2" & vbCrLf & vbCrLf) 
'  wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.3" & vbCrLf & vbCrLf) 
'  wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.4" & vbCrLf & vbCrLf) 

'  For i = 1 To wd.Sections(1).Range.Words.Count 
'   Debug.Print wd.Sections(1).Range.Words(i).Characters.Count & " "; 
'   Debug.Print wd.Sections(1).Range.Words(i) & " " 
'  Next 


'  debug_aTestEmail wd 

'  wd.Sections(2).Range.InsertAfter ("after2.1" & vbCrLf & vbCrLf) 
'  wd.Sections(2).Range.InsertAfter ("after2.2" & vbCrLf & vbCrLf) 
'  wd.Sections(2).Range.InsertAfter ("after2.3" & vbCrLf & vbCrLf) 
'  wd.Sections(2).Range.InsertAfter ("after2.4" & vbCrLf & vbCrLf) 

     Set wd = Nothing 
     Set outMail = Nothing 
    End Sub 


    Sub debug_aTestEmail(wd As Document) 

     Debug.Print "------------------------------------------------" 
     Debug.Print " wd.Sections.Count : " & wd.Sections.Count 
     Debug.Print " wd.Paragraphs.Count : " & wd.Paragraphs.Count 
     Debug.Print " wd.Sentences.Count : " & wd.Sentences.Count 
     Debug.Print "  wd.Words.Count : " & wd.Words.Count 
     Debug.Print " wd.Characters.Count : " & wd.Characters.Count 
     Debug.Print "  wd.Range.End : " & wd.Range.End 
     Debug.Print "wd.StoryRanges.Count : " & wd.StoryRanges.Count 
     Debug.Print "------------------------------------------------" 

     Debug.Print wd.Tables.Count 


    End Sub