2 varianty. Ak Vám nie je jasný rozdiel, píšte.
Sub a()
Dim xOutApp As Object
Dim xOutMail As Object
Dim WS As Worksheet
ThisWorkbook.Save
On Error Resume Next
Set xOutApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If xOutApp Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
End If
Set xOutMail = xOutApp.CreateItem(0)
Set WS = ThisWorkbook.ActiveSheet
On Error Resume Next
With xOutMail
.To = WS.Range("A1")
.CC = WS.Range("A2")
.BCC = WS.Range("A2")
.Subject = WS.Range("A3")
.Body = xMailBody
.Attachments.Add ThisWorkbook.FullName
.Display 'or use .Send
End With
If Err.Number <> 0 Then
MsgBox "Pri odosielaní mailu došlo k chybe !", vbCritical
End If
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub b()
Dim xOutApp As Object
Dim xOutMail As Object
Dim WS As Worksheet
Dim tmpFile As String
tmpFile = Environ$("temp") & "\" & ThisWorkbook.Name
ThisWorkbook.SaveCopyAs tmpFile
On Error Resume Next
Set xOutApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If xOutApp Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
End If
Set xOutMail = xOutApp.CreateItem(0)
Set WS = ThisWorkbook.ActiveSheet
On Error Resume Next
With xOutMail
.To = WS.Range("A1")
.CC = WS.Range("A2")
.BCC = WS.Range("A2")
.Subject = WS.Range("A3")
.Body = xMailBody
.Attachments.Add tmpFile
.Display 'or use .Send
End With
If Err.Number <> 0 Then
MsgBox "Pri odosielaní mailu došlo k chybe !", vbCritical
End If
On Error GoTo 0
Kill tmpFile
Set xOutMail = Nothing
Set xOutApp = Nothing
Set WS = Nothing
End Sub
Sub a()
Dim xOutApp As Object
Dim xOutMail As Object
Dim WS As Worksheet
ThisWorkbook.Save
On Error Resume Next
Set xOutApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If xOutApp Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
End If
Set xOutMail = xOutApp.CreateItem(0)
Set WS = ThisWorkbook.ActiveSheet
On Error Resume Next
With xOutMail
.To = WS.Range("A1")
.CC = WS.Range("A2")
.BCC = WS.Range("A2")
.Subject = WS.Range("A3")
.Body = xMailBody
.Attachments.Add ThisWorkbook.FullName
.Display 'or use .Send
End With
If Err.Number <> 0 Then
MsgBox "Pri odosielaní mailu došlo k chybe !", vbCritical
End If
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub b()
Dim xOutApp As Object
Dim xOutMail As Object
Dim WS As Worksheet
Dim tmpFile As String
tmpFile = Environ$("temp") & "\" & ThisWorkbook.Name
ThisWorkbook.SaveCopyAs tmpFile
On Error Resume Next
Set xOutApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If xOutApp Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
End If
Set xOutMail = xOutApp.CreateItem(0)
Set WS = ThisWorkbook.ActiveSheet
On Error Resume Next
With xOutMail
.To = WS.Range("A1")
.CC = WS.Range("A2")
.BCC = WS.Range("A2")
.Subject = WS.Range("A3")
.Body = xMailBody
.Attachments.Add tmpFile
.Display 'or use .Send
End With
If Err.Number <> 0 Then
MsgBox "Pri odosielaní mailu došlo k chybe !", vbCritical
End If
On Error GoTo 0
Kill tmpFile
Set xOutMail = Nothing
Set xOutApp = Nothing
Set WS = Nothing
End Sub
Příloha: 
56376_odoslat-mail-z-vba.zip (16kB, staženo 2x)
citovat56376_odoslat-mail-z-vba.zip (16kB, staženo 2x)
RSS nejnovější články