Zaslal/a
23.7.2024 18:59zdravim pouzivam tento kod na odosielanie celeho zosita cez outlock. Problem je v tom ze mi vypisuje pocas odoslania doslo k chybe sice subor odosle ale druhy krat uz nie lebo sa outlock nedokazal sam zatvorit musim to robit vzdy manualne a dat ukoncit ulohu.
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim OLApp As Object, eMailAdresa As String, Ucet As String, oAccount, bOK As Boolean
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
For Each oAccount In OLApp.Session.Accounts
If oAccount = Ucet Then bOK = True: Exit For
Next oAccount
If Not bOK Then MsgBox "Tento účet v Outlooku neexistuje." & vbNewLine & Ucet: Exit Sub
On Error Resume Next
With OLApp.CreateItem(0)
.To = eMailAdresa
.Subject = "Záloha vyučtovanie"
.Body = ""
.Attachments.Add ThisWorkbook.FullName
Set .SendUsingAccount = oAccount
.Send
.Display
End With
If Err.Number <> 0 Then MsgBox "Počas odosielania došlo k chybe.", vbCritical
On Error GoTo 0
Set OLApp = Nothing
End Sub
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.