dobrý den,
zkuste tohle:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim bOK As Boolean
Dim OLApp As Object, oAccount As Object
Dim eMailAdresa As String, Ucet As String
eMailAdresa = "bistroumuta@gmail.com"
Ucet = "bistroumuta@gmail.com"
If MsgBox("Chcete odoslať tento súbor na email ?" & vbNewLine & eMailAdresa, vbYesNo + vbQuestion) = vbNo Then Exit Sub
On Error Resume Next
Set OLApp = GetObject(, "Outlook.Application")
If OLApp Is Nothing Then Set OLApp = CreateObject("Outlook.Application")
On Error GoTo 0
If OLApp Is Nothing Then
MsgBox "Outlook nieje možné spustiť", vbCritical
Exit Sub
End If
For Each oAccount In OLApp.Session.Accounts
If oAccount = Ucet Then
bOK = True
Exit For
End If
Next oAccount
If Not bOK Then
MsgBox "Tento účet v Outlooku neexistuje." & vbNewLine & Ucet
Exit Sub
End If
On Error Resume Next
With OLApp.CreateItem(0)
.To = eMailAdresa
.Subject = "Záloha vyučtovanie"
.Body = ""
.Attachments.Add ThisWorkbook.FullName
Set .SendUsingAccount = oAccount
.Send
End With
If Err.Number <> 0 Then
MsgBox "Počas odosielania došlo k chybe.", vbCritical
End If
On Error GoTo 0
' Properly release the object
Set OLApp = Nothing
' Close Outlook
If OLApp Is Nothing Then
CreateObject("WScript.Shell").Run "taskkill /f /im outlook.exe", 0, True
End If
End Subcitovat
zkuste tohle:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim bOK As Boolean
Dim OLApp As Object, oAccount As Object
Dim eMailAdresa As String, Ucet As String
eMailAdresa = "bistroumuta@gmail.com"
Ucet = "bistroumuta@gmail.com"
If MsgBox("Chcete odoslať tento súbor na email ?" & vbNewLine & eMailAdresa, vbYesNo + vbQuestion) = vbNo Then Exit Sub
On Error Resume Next
Set OLApp = GetObject(, "Outlook.Application")
If OLApp Is Nothing Then Set OLApp = CreateObject("Outlook.Application")
On Error GoTo 0
If OLApp Is Nothing Then
MsgBox "Outlook nieje možné spustiť", vbCritical
Exit Sub
End If
For Each oAccount In OLApp.Session.Accounts
If oAccount = Ucet Then
bOK = True
Exit For
End If
Next oAccount
If Not bOK Then
MsgBox "Tento účet v Outlooku neexistuje." & vbNewLine & Ucet
Exit Sub
End If
On Error Resume Next
With OLApp.CreateItem(0)
.To = eMailAdresa
.Subject = "Záloha vyučtovanie"
.Body = ""
.Attachments.Add ThisWorkbook.FullName
Set .SendUsingAccount = oAccount
.Send
End With
If Err.Number <> 0 Then
MsgBox "Počas odosielania došlo k chybe.", vbCritical
End If
On Error GoTo 0
' Properly release the object
Set OLApp = Nothing
' Close Outlook
If OLApp Is Nothing Then
CreateObject("WScript.Shell").Run "taskkill /f /im outlook.exe", 0, True
End If
End Subcitovat
\n
RSS nejnovější články