Soubor je ulkozený na serveru a pouzívají ho 3 lide. Ted jsem pripojil dalsi PC a kod mi prestal fungovat. Stejný problém ja v diskuzi zde. https://pc-help.cnews.cz/viewtopic.php?f=35&t=206016
VBA mi vyhodí hlášku Run- time error´1004´: a soubor se neuloží.
Postup který je uvedený v diskuzi mi nepomáhá.
Prosím o pomoc. Děkuji.
Tady je prý chyba ale nevím proč.
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Soubor, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Kód: Vybrat vše
Sub OutlookPriloha()
Dim objNsp As Object, colSyc As Object, objSyc As Object, i As Integer, adresat As String, Soubor As String
'!!!!!Před použitím je třeba v Tools / References zaškrtnout volbu Microsoft Outlook xx.0 Object Library.!!!!!
'Tools / References / Microsoft Outlook x.x Object Library
With ActiveSheet
With .Range("G13") ' toto je buňka kde se na listě vypíše datum a čas
.Value = Now()
.NumberFormat = "d/m/yy h:mm;@"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Uložení souboru
'Range C35 = datum
'Range L1 = Jméno
Soubor = "Z:\dokumenty\" & .Range("F7") & " " & .Range("H3") & "" & .Range("M2") & ".pdf" ' Tady se vylní cesta kam chcete soubor uložit, C35
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Soubor, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set objNsp = OutApp.Application.GetNamespace("MAPI") 'CORRECTION to Refer to the OutLook Application correctly
Set colSyc = objNsp.SyncObjects
adresat = Range("O1") ' emailová adresa příjemce
With OutMail
'adresát
.To = adresat
'kopie pro
'.CC = Range("R2")
'skrytá kopie pro
'.BCC = ""
'předmět zprávy
.Subject = "protokol"
'text zprávy a určení buňky
.Body = "Prosím vyplňte a obratem zašlete zpět." & Chr(13) & Chr(13) & "Děkuji."
'aktivní (uložený) sešit jako příloha
.Attachments.Add Soubor
'Nastavení preferovaného účtu pro odeslání pošty - v tomto případě druhý v pořadí
'Dostupné od verze Office 2007
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
'odeslání zprávy
.Send
End With
'Range("D13:D17").ClearContents
'Range("F7:I11").ClearContents
Range("M7:N11").ClearContents
Range("M21:M29").ClearContents
Range("M13:M17").ClearContents
'Range("B41:F46").ClearContents
'Range("H46").ClearContents
Range("G13").ClearContents
For i = 1 To colSyc.Count
Set objSyc = colSyc.Item(i)
objSyc.Start
Next i
'OutApp.Quit
'MsgBox "Zpráva byla odeslána na adresu: " & adresat, vbInformation
'uvolnění z paměti
Set OutMail = Nothing: Set objNsp = Nothing: Set colSyc = Nothing: Set objSyc = Nothing: Set OutApp = Nothing
End Sub
