Dobrý den, používám tento kód pro odesílání emailu skrze ovládací tlačítko v excelu. Potřeboval bych ale, aby se mi do těla emailu vložil obsah aktuálního listu. Poradíte mi prosím někdo, jak na to? Moc předem děkuji!
dobrý den, třeba takto.
Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim rng As Range
Dim obsah As String
Dim radek As Integer, sloupec As Integer
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
Set rng = UsedRange
For radek = 1 To rng.Rows.Count
For sloupec = 1 To rng.Columns.Count
obsah = obsah & " " & rng.Cells(radek, sloupec).Value
Next
obsah = obsah & vbNewLine
Next
xMailBody = "Body content" & vbNewLine & vbNewLine & _
"Copy from excel sheet" & vbNewLine & vbNewLine & obsah
On Error Resume Next
With xOutMail
.To = "test@seznam.cz"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set rng = Nothing
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
citovat
Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim rng As Range
Dim obsah As String
Dim radek As Integer, sloupec As Integer
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
Set rng = UsedRange
For radek = 1 To rng.Rows.Count
For sloupec = 1 To rng.Columns.Count
obsah = obsah & " " & rng.Cells(radek, sloupec).Value
Next
obsah = obsah & vbNewLine
Next
xMailBody = "Body content" & vbNewLine & vbNewLine & _
"Copy from excel sheet" & vbNewLine & vbNewLine & obsah
On Error Resume Next
With xOutMail
.To = "test@seznam.cz"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set rng = Nothing
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
citovat
\n
RSS nejnovější články